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FOREWORD 


This report, prepared by the Dynamics and Loads Section, Martin 
Marietta Corporation, Denver Division, under Contract NAS3-30761, 
presents the results of a study that developed a digital computer 
program for dynamic analysis of a flexible spacecraft with ro- 
tating components. The study was performed from April 1974 to 
August 1975 and was administered by the National Aeronautics and 
Space Administration, George C. Marshall Space Flight Center, 
Huntsville, Alabama, under the direction of Dr. John Glaese. 

The report is published in three volumes: 

Volume I - Analytical Developments 
Volume II - Program Guide and Examples 
Volume III - Program Code 
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ABSTRACT 


This document details analytical procedures and digital computer 
code for the dynamic analysis of a flexible spacecraft with rotating 
components t Two major subject areas are considered! 

(1) nonlinear response in the time domain, and 

(2) linear response in the frequency domain. 

The spacecraft is assumed to consist of an assembly of connected 
rigid or flexible subassemblies. The total system is not restricted 
to a topological connection arrangement and may be acting under the 
influence of passive or active control systems and external environments. 

The analytics and associated digital code provide the user with the 
capability to establish spacecraft system nonlinear total response 
for specified initial conditions, linear perturbation response about 
a caic'jlated or specified nominal motion, general frequency response 
and graphical display, and spacecraft system stability analysis. 

The document is presented in three volumes. 
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fHDG. 


C 

c 

c 

c 


,p 

DYNAMO 

-000001 

IS 

DYNAMO 

-000002 

COMPILFR ( XNsl),(EOUIV=:CNN) 

-000003 

lOGRAM 

DYNAMO — DYNAMIC ANALYSIS OF A FLEXIBLE SPACECRAFT WITH 

-000004. 


ROTATING COMPONENTS, CONTRACT NAS8-30761, 

-000005 


PREPARED FOR MARSHALL SPACE FLIGHT CENTER 

-000006 



-000007 

IMPLICIT DOUBLE PRECISIONIA-H»D-Z) 

-000008 



000009 


COMMON /DR AT 10/ 

000010 

♦ 

IFLl, IFL2,DRVFC (1501 

10000011 


COMMON /G60ATA/ 

000012 

♦ 

GAMGI 13 I ,GMAG,RCMAG 

000013 


COMMON /ILINER/ 

000014 

* 

IFLNER 

000015 


COMMON /MAXMUM/ 

000016 

* 

NBMAX ,NHMAX,NSPMAX,NMWMAX,NMWBOD,NMDBOD,KMU,KY,KU 

000017 


COMMON /MISCNO/ 

OOOOIP 

♦ 

NOPRNT, NOPLOT 

000019 


COMMON /NUMBRS/ 

000020 

♦ 

ZRO,ONE,TWO,TRES 

000021 


COMMON /PLTDTA/ 

000022 


NRP LOT, NC PLOT 

000023 


COMMON /SPECIF/ 

000024 

♦ 

BETAHIG, 5),BETAKDf6, 5),AMO(2, 5) ,RH(3,3,24),PSt3,3,20>, 

1600025 

♦ 

DH(3,2e),DS(3,2DI,IM0(3, 5),NMOW(5, 5) ,IFTSMN(10) , 

1700026 


NB,NH,NSPT,NOFMO,NDELTA,ITCPOH2, 5),1RGFLXI B),IHDATAf7, 

51, 1800027 

♦ 

LOCU( 12),LENUf12),NU,NBETA,NLAM,NE0 

1900028 


COMMON /TAPENO/ 

000029 

♦ 

NTAPE 1 ,NTAPF2 ,NTAPE3 

000030 



000031 

IFLl 

= 0 

000032 



000033 

NTAPEl = 1 

000034 

MTAPE2 = 2 

000035 

NTAPE3 = 3 

000036 

NPMAX =5 

4100037 

NHMAX = 5 

4200038 

NSPMAX = 10 

4300039 

NMMMAX s 5 

4400040 

NMWPOO = 3 

4500041 

NMOBOO = 6 

4600042 

KMU 

= 15 

4700043 

KY 

= 250 

4800044 

KU 

= 65 

4900045 



000046 

ZRO 

s 0.0 0 

000047 

ONE 

= 1.0 0 

000048 

TWO 

= 2.0 0 

000049 

TPFS 

= 3.0 0 

000050 
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C 000051 

999 CALL START 000052 

CALL COMFNT 000053 

C 000054 

REWIND NTAPEl 000055 

REWIND NTAPE2 000056 

REWIND NTAPE3 000057 

C 000058 

CALL DYNSAA >000059 

CALL OYNSBB -000060 

CALL DYNSEEdFLNER.NOPLOT) -000061 

60 TO 999 000062 

C 000063 

end 000064 


I 

I 

L. 


fHOG*l* ADDT -000065 

IFORylS AOOT -000066 

COMPILER f XM=1)»(E0UIV>=CMN) -000067 

DOUBLE PRECISION FUNCTION AOOT I1C,TI -000068 

IMPLICIT DOUBLE PRECISION CA-H.O-ZI -000069 

COMMON /VECTOR/ 000070 

* Vf?50l,YDTf250» 2000071 

IF lie .EO. 19) GO TO 20 000072 

ADDT = YDTI65) 000073 

RETURN 00007A 

20 AOOT a Y0T(66) 000075 

RETURN 000076 

C 000077 

end 000078 
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[HDGyP ADD3 
t FOR, IS AD03 

COMPILER f XHsl),fEQUIV«CMN} 

SUBROUTINE ADD3I ALPHA, A,BETA,e , GAMMA ,C ,NR ,NC ,KR) 
IMPLICIT DOUBLE PRECISICN!A-H,0~2 ) 

MATRIX ADDITION A = ALPHA*A ♦ BETA*B ♦ GAMMA*C 

WHERE ALPHA, BETA, GAMMA ARE INPUT SCALARS AND 
A, 6, C ARE INPUT MATRICES ^NR,NC) 

DIMENSION A(KR,n,B(KR,l),C<KR,l) 

C 

DO 10 1=1, NR 

no 10 j=i,NC 

10 A(I,JI = AlPHA*AfI,J) ♦ BETA«BtI,Jl ♦ GAMMA*C(I,JI 
C 

RETURN 


-000079 

-ooooeo 

-000081 

000082 

-000083 

000084 

000085 

000086 

000087 

000088 

000089 

000090 

000091 

000092 

000093 

000094 

000095 


END 


000096 


I 


1 11111 


s 

tHDGfP AOT “0000<?7 

[FOR* IS ADT >000096 

COMPILFR (XM-l)rfEQUIVsCMN) -000099 

DOUBLE PRECISION FUNCTION AOT CIC*T> -000100 

IMPLICIT DOUBLE PRECISION CA-H,0-2) -000101 

COMMON /VECTOR/ 000102 

* Yf250l,Y0T<?50) 2000103 

C 000104 

IF (IC .EO. 191 GO TO 20 000105 

ADT = YC65» 000106 

RETURN 000107 

20 ADT = Y(66| 000108 

RETURN 000109 

C . 0001 10 

END 000111 
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CHDGtP ALPHAA -000112 

IFOR, IS ALPHAA -000113 

COMPILER !XM=l)f (EQUlVsCMNI -000114 

SUBROUTINF ALPHAA (ALPHA* A»ZtHR»NC»KRt 000115 

IMPLICIT DOUBLE PRECIS1CN(A-H,0-Z I -000116 

DIMENSION A(KRtl)* Z(KR*1| 000117 

C 000118 

C SCALAR ALPHA TIMES MATRIX A. (ALPHA * A s Z). 000119 

C matrices A,Z may share same core LOCATIONS. 000120 

C CODED BY RL WOHLEN. FEPRUARY 1965. 000121 

C 000122 

C SUBROUTINE ARGUMENTS 000123 

C ALPM*. = INPUT SCALAR. 000124 

C A = INPUT MATRIX. S1ZE(NR»NCI. 000125 

C Z = OUTPUT RESULT MATRIX. SIZE(NR,NC). 000126 

C NR = INPUT NUMBER OF ROWS IN MATRICES A*Z. 000127 

C NC = INPUT NUMBER OF COLS IN MATRICES A*Z. 000128 

C KR = INPUT ROW DIMENSION OF A,Z IN CALLING PROGRAM. 000129 

C 000130 

DO 10 1=1, NR 000131 

DO 10 J=1,NC 000132 

10 ZtIfJ} = ALPHA * A(I,J) 000133 

RETURN 000134 

END 000135 
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tHDGfP ASIMLR 

r FOR* IS ASIMLR 

COMPILFR f XMsl)»(FOUIV=CMN) 

SUBROUTINE ASIMLR (AfB»IV*KR) 

IMPLICIT DOUBLE PRECISION fA-H*0-Z> 

C 

C SUBROUTINE ESTABLISHES TRANSFORMED PARTIAL DERIVATIVE MATRIX 
C BY PERFORMING A SIMILARITY TRANSFORMATION TO 

C EXCHANGE PLANT STATE VARIABLES ,Y, FOR SENSOR SIGNALS*XSS 

C AND CONTROL SYSTEM VARIABLES »DEITA« FOR TORQUE 

C VARIABLES *B. 

C 

C THE VAIRABLE SEQUENCE IS REORDERED FROM Y.DFLTA.XSS.B 
C TO Y,XSS*DELTA*B 

C 

C SUBROUTINE ARGUMENT DESCRIPTIONS 

C 

C A = INPUT MATRIX OF PARTIAL DERIVATIVES. COORDINATE ORDER 

C IS Y,DELTA*XSS*6. SIZE IS NJQ,NX 

C B = OUTPUT TRANSFORMED AND REORDERED PARTIAL DERIVATIVE 

C MATRIX. ORDER IS Y*XSS»DELTA*B. SIZE IS NX*NX. 

C IV = INPUT INTGER WORK VECTOR. SIZE MOST BE AT LEAST NX. 

KR = INPUT ROW DIMENSION SIZE OF A AND B IN CALLING PROGRAM. 

DIMENSION AfKR»ll* 6(KR«1), IV(1) 

COMMON /LDSIZE/ 

? NX, NY, NDLTA, NXSS, NB, NJQ, NY2, ND2 

COMMON /TAPENO/ 

4 NUTl, NUT2, NUT3 

COMMON /VECTOR/ 

E Y (2501, YD (2501 

SET UP C. LOWER PART OF -A- REQUIRED TO OBTAIN -T-. 

NR = NJQ - NX 
NC = NX NR 

CALL ZERO (B,NR,NC,KRI 
00 10 1=1, NR 
L=I ♦ NX 
DO 10 J=1,NX 
B(I,J) = A(L,J) 

IF (I .FO. J) B(I,L) = -l.DO 
10 CONTINUE 

B = -C- 

ESTABLISH SEARCH LIMIT FOR SUBROUTINE FINOT 
NS = NX 


“000136 

-000137 

“000138 

000139 

“000140 

000141 

000142 

000143 

000144 

000145 

000146 

000147 

000148 

000149 

000150 

000151 

000152 

00015? 

000154 

000155 

000156 

000157 

000158 

000159 

000160 

000161 

000162 

000163 

000164 

000165 

000166 

43000167 

000168 

000169 

000170 

000171 

000172 

000173 

000174 

000175 

000176 

000177 

000178 

000179 

000180 

000181 

000182 

000183 

000184 

000185 
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CALL FINOT f B*NR»NC»NS»AtNRET»KRtKR} 
CALL WRITE (A»NRET,NRET»4H-T- ,KRl 


A = -T- 

FORM -A*- = HINV) A T 

READ (NUT2) f (6 1 1 1 J) t I'l «KR ) » KR ) 

WRITE (NUT2) ((A(I,JI» l=ltKR» ,Jel,KR| 

REWIND NUT2 

INVERT -T- USING GAUSSI 

CALL GAUSSI (A,P,NRET,KR» 

B = TCINVI 

TRANSFORM STATE VECTOR FOR POSSIBLE USE IN LINEARIZED RESPONSE. 
CALL MULTB l6,YtNRETtNRET,l*KR»KR ) 

CALL WRITE CY,1,NRET,4H Y* ,l» 

READ (NUT2» <(A( I»J)»IsltKR)tJ-l»KR) 

CALL MULTA (Bt A»NXtNX»NX»KRtKR) 

B= TIINV) * -A~ 

READ (NUT2I ( f A(If J)»I-1»KRI, J=I*KR) 

REWIND NUT2 

CALL MULTB (B tA«NX*NX»NX»KRtKR> 

B = -k*~ 


REORDER FROM Y*DELTA, XSS*B 
TP Y,XSS, DELTA. B 

DO 20 1=1, NX 
20 IVII) = I 

DO 30 I=1,NXSS 
L = NY2 ♦ I 
K = L ♦ ND? 

30 IV<K1 = L 

DO 40 1=1, ND2 
K = NY? + 1 
L = NY2 ♦ NXSS ♦ I 
40 1V(K) = L 

CALL ZFRO (B,NX,NX,KR» 

CALL REVADD ( 1 .DO, A, IV,IV,B,NX,NX,NX,NX ,KR,KR ) 

RETURN 

END 
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000189 
000.190 
000191 
000192 
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000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
OG0210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
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[HDG»P BABT 



-000228 

tFORtlS BABT 



-000229 


COHPILER f XMsl)» (EOUIV=CMN) 



-000230 


SUBROUTINE BABT f AtB fZtNRB,NCB,KA,KB J 



000231 


IMPLICIT DOUBLE PPECISIONIA-H,0-Z» 



-000232 


DIMENSION AfKA.n* 6(K6,1), Z(KB.l) 



000233 


COMMON /LWRKVl/ Nf 50) 



48000234 

C 




000235 

C 

SPECIAL TRIPLE MATRIX PRODUCT. B*A*B TRANSPOSE ) 

= Z. 

000236 

C 

A MUST BE SYMMETRIC TO GET CORRECT ANSWER. 



000237 

c 

Z WILL BE symmetric. UPPER HALF CALCULATED, REFLECTED TO LOWER HALF. 

000238 

c 

THE MAXIMUM SIZE IS 



000239 

c 

NCB = 500 



000240 

c 

OEVELOPFO BY CARL BODLEY. JANUARY 1965. 



000241 

c 

LAST REVISION BY RL WOHLEN. JULY 1972. 



000242 

c 




000243 

c 

SUBROUTINE ARGUMENTS 



000244 

c 

A = INPUT INNER MATRIX. SIZE(NCB,NCB ) . 



000245 

c 

B = INPUT 0UTE» MATRIX. SIZE(NRB,NCB ). 



000246 

c 

Z = OUTPUT RESULT MATRIX. SIZE(NRB,NRB ) , 



000247 

c 

NRB = INPUT NUMBER OF ROWS OF MATRIX B, SIZE 

OF 

MATRIX Z. 

000248 

c 

NCB = INPUT NUMBER OF COLS OF MATRIX B, SIZE 

OF 

MATRIX A. MAX=500. 

000249 

c 

KA = INPUT ROM DIMENSION OF A IN CALLING PROGRAM. 

000250 

c 

KB = !N«»UT ROW DIMENSION OF B,Z IN CALLING 

PROGRAM- 

000251 

c 




000252 

c 




000253 


DO 40 J=1,NRB 



000254 


DO 20 L=1,NCB 



000255 


S = O.DO 



000256 


DO 10 X=1,NCE 



000257 


10 S = S ♦ AIL,K)«BIJ,K) 



000258 


20 M(L) = S 



000259 


DO 40 1=1, J 



000260 


S = 0-00 



000261 


00 30 L=1,NCB 



000262 


30 S = S ♦ B(I,L)«W(L) 



000263 


ZCI,J) = S 



000264 


40 Z(J,n = S 



000265 


RETURN 



000266 


END 



000267 
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fHOGtP BAKSLV 
[FOR, IS BARSLV 

COMPILER (XN=l),(EOUIVsCMN) 
SUBROUTINE BAKSLV (BWtNLAM,VtD«K6W) 
IMPLICIT DOUBLE PRECISION! A>HtO-ZI 
DIMENSION BVf(KRW»l)»V(XI»D! 1) 

C 

DO 25 Is2,NLAM 
IMl ft I - 1 
DO 25 Jftl.IMl 

25 Vm ft V(I) - BWfJvIt^VIJ) 

DO 2? Iftl.NLAM 
27 V!I» ft v(i)/om 

NLl ft NLAM - 1 
DO 30 1=1, NLl 
L ft NLAM - I 
LPl ft L ♦ 1 
DO 30 JftLPlfNLAM 
30 VCL» ft V!L» - BW!L,J1»VIJI 
C 

RETURN 

END 


-000268 

-000269 

-000270 

000271 

-000272 

000273 

000274 

000275 

000276 

000277 

000278 

000279 

000280 

000281 

000282 

000283 

000284 

000285 

000286 

000287 

000288 

000289 


[KDG,P BOOTQP 
t FOR t IS BDOTOP 

COMPILFR (XHsDtfEQUIV-CMN) 

SUBROUTINE BOOTQP (I tBDTQtBDTP » 

IMPLICIT OOUBLF PREC ISION ( A-H ,0-Z ) 

DIMENSION BOTOC6,1 ),BDTP(6,1) 

C 

COMMON /BHBSRD/ 

* BH(6,1?» 9)«B5.{6tl2tl0)tR0Lf3t3t 5)»DOL(3* 5) 

COMMON /HANDS / 

* HATHO, 6t 8)«SIGH(3» 6t 8)tHATS(3t 6ylO)ySIGS(3« 6*10) 

COMMON /NUMBRS/ 

♦ ZRO,ONEtTWO,TRES 

COMMON /PINRP / 

♦ PIN(3,3, 5), RP2(3,3, 5), RP3C3,3, 5) 

COMMON /SPEC IF/ 

* BETAH(6, 5»,BETAHD(6, 5)tAM0(2, 5 ) ,RH(3.3 .24 ) *RS(3 ,3 ,20 » , 

* 0H(3,281,DS(3,20),IM0I3, 5J,NMOW<5, 5) , IFTSMW (10 » , 

♦ NP.,NH,NSPT,N0FM0,NDELTA,IT0P0LC2, 5),IRGF|.X( 5),IHDATA(7, 5), 

* LOCUf 12l,lENUfl2»,NU,NBETA,NLAM,NE0 

COMMON /VECTOR/ 

♦ Y(250 ),YDT(250> 

C 

DIMENSION P1NDT(3,31 ,HXDQN(3),SXDQN(3»,HXDPM(3 »,SXDPMC3),RQP(3,3), 

♦ RPMC3,3),RQN(3,31,RPN(3,3> ,R0M(3,3 J,0RPQ(3,3J ,DR0P(3,3), 

* ORON(3,3),DRQM(3,3),SNQ(3,3I,SMP(3,3),WON(3) ,WPM f 3 » ,WPQP(3 I , 

♦ WSK(3,3), VEC(3) 

C 

DO 3 1=1,6 
DO 3 J=l,6 
BDTQCI.Jl = ZRO 
3 BDTPd.JI = ZRO 

IF (L .EQ. 1) GO TO 100 
C 

CC GET D/OT{Plf INVERSEll 
E20T = BETAHD(2,U 
B30T = BETAHD(3,L) 

DO S 1=1,3 
DO 5 J=l,3 

5 PINOT(I,J) = P2DT*RP2(I,J,LJ B3DT*RP3 1 1 , J,U 


NOBO = 

IT0P0L(1,L) 


NOBP = 

IT0P0L(2,U 


LOO = 

LOCU(NOBO) 

6 

LOP = 

LOCU(VOBP) + 

6 

LEQ = 

IRGF LX (NOBO) 


LEP = 

IRGFLX(NOBP) 


LHSO = 

2*L - 3 


LHSP = 

LHSQ + 1 


IF (LEO ,E0. 0) GO 

TO 


-000290 

-000291 

-000292 

000293 

-000294 

000295 

000296 

000297 

200298 

000299 

400300 

000301 

000302 

000303 

1300304 

000305 

1600306 

1700307 

1800308 

1900309 

000310 

2000311 

000312 

000313 

000314 

000315 

000316 

000317 

000318 

000319 

000320 

000321 

000322 

000323 

000324 

000325 

000326 

000327 

000328 

000329 

000330 

000331 

000332 

000333 

000334 

000335 

000336 

000337 

000338 

000339 
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CALL NULT3 (HATHtl,l»LHSQ) »Y{LOO),HXDQN«3*LEO»lt3tl*l) 
CALL MULT3 (SI6HI l,ltLHSO) »Y(L0Q),SXDQN,3»LEQ,lt3tl*ll 
10 IF (LEF .EQ. 01 GO TO 20 

CALL MULT3 iHATHf 1,1*LHSPI fYIL0P)tHX0PM,3fLEPtl»3,l,l) 
CALL MULT3 fSI6H(l»ltLHSP)»YaOP),SXDPM»3»LEPtl»3fl»ll 
20 LRNQ = 6*IL-2I ♦ 3 
LRHP = LRNQ ♦ 1 
LRPO = LPNO ♦ 2 
LONQ = 7*(L“2I ♦ 3 
LOMP = LONQ ♦ 1 
DO 15 I=lf3 
00 15 J=l,3 

RQPfItJI = RHIJ,I*LRPQ> 

RQNfl.Jl = RH(J,I,LRNQ) 

15 RPMlItJI = RH(J,I.LRMP| 

CALL NULT3 (RQP,RPM,RQM«3»3,3*3*3,3) 

CALL MULT3 f RHf 1»1,LRPQI fRQN,RPN,3»3»3,3«3»3l 
CALL SKEWV3 (DH(ltLDNQ) ,SNQt3»31 
CALL SKEWV3 (DH(ltLOMP) •SNPt3t31 

IQ = LOCU(NOBQ) - 1 
IP = LOCUINOPP) - 1 
00 25 I=l»3 
WQN(1» = -Y(IQ+II 

25 HPMfll s= YflP*I) 

IF (LEQ .EQ. 0) GO TO 26 
00 27 1=1*3 

27 WONdl = WCNCl) “ SXOONfl) 

26 IF (LEP .EO. 0) GO TO 28 
DO 29 1=1,3 

29 WPMII) = WPMfl) ♦ SXDPMIl) 

28 CALL MULT3 (RPM,WPM*WPQP*3*3*l,3*l*n 
CALL MULTAD dPN,WON,WPQP, 3,3, 1*3*1, 1) 

CALL SKEWV3 (MPQP,NSK,1 ,31 

CALL MULT3 fWSK.RHf 1,1,LRPQ) ,DRPQ,3,3,3,3,3,3I 
00 30 1=1,3 
00 30 J=l,3 

30 0RQP(I,J1 = DRPQfJ,!) 

CALL MULT3 (DRP0,R0N,BDTQf4,4| ,3,3,3,3,3,61 
CALL ML'LT3 *0RQP,®PM,0PQM,3,3,3,3,3,3I 
CALL MULT3 (PINOT ,R0N,BDTQ,3, 3,3,3, 3,6 1 
IF (LEQ .EQ. 0) GO TO 35 
CALL NULT3 (RQN*SXDQN,VEC,3,3,1,3,1 ,1) 

CALL SKEWV3 (VEC,W$K,1,31 

CALL MULT3 (WSK,R0N,DRQN,3,3,3,3,3,3 1 

CALL MOLTAO (RH(1,1,LRPQ) ,0RQN,B0TQ(4,4),3,3,3,3,3,6> 

CALL MULTAO (PINfl ,1 ,L 1 ,DRQN,BDTQ,3,3,3 ,3,3,6 1 

CALL MULT3 (BOTQ(4,4),SNQ,BDTO(4,1),3,3,3,6,3,6) 

CALL SKEUV3 (HX0QN,WSK,1 ,31 


000340 

000341 

000342 

000343 

000344 

000345 

000346 

000347 

000348 

000349 

000350 

000351 

000352 

000353 

000354 

000355 

000356 

000357 

000358 

000359 

000360 

000361 

000362 

000363 

000364 

000365 

000366 

000367 

000368 

000369 

000370 

000371 

000372 

000373 

000374 

000375 

000376 

000377 

000378 

000379 

000380 

000381 

000382 

000383 

000384 

000385 

000386 

000387 

000388 

000389 
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C 


C 


CALL MULTAD 
CALL MULT3 
CALL M'J'LT3 
GO TO 40 
35 CALL MULT3 
40 CONTINUE 


fRPNtMSKtB0TQ(4»l)»3»3t3t3t3»6) 

fBDTQ»SIGH(l»lfLHS0)tBDTQ{l,7)»3»3tLEQ»6»3t6) 

(B0TQ(4«4t«KATHCltltLHS0)»BDTQr4,7)»3«3»LEQt6«3*6} 

fBOTO(4,4),SNO»BDTO(4.1)t3t3t3»6,3t6) 


IF ILEP .EO. 
CALL MULT3 
CALL SKEWV3 
CALL MULT3 
CALL MUL'nt 
CALL MULT3 
CALL HULTA.0 
CALL MULTAD 
CALL EKEWV? 
CALL MULTAD 
DO 55 1=1,3 
IP3 = 1 + 3 


0» GO TO 50 

(RPM, SX0PM,VEC,3, 3,1,3 flyl) 
fVEC,MSK,l,3) 

IMSK,RPM,BOTP(4,4) ,3, 3, 3, 3, 3, 6) 

(PTNDT.RQMfBDTP (1,1 1,3,3,3,3,3,61 

(BDTP(4,41,SMP,BDTPf4,ll,3,3,3,6,3,61 

(R0P,B0TP(4,41,DR0M,3,3,3,3,6,31 

(PIN(1,1,L1,DRQM,BDTP,3,3,3,3,3,61 

(HX0PM,WSK,1,31 

(RPM,WSK,BDTP (4,1 1,3,3,3,3,3,61 


DO 55 J=l,3 
JP3 = v» + 3 

B0TP(1,J1 = -BDTP(I,J1 
B0TP(IP3,J1 = -B0TP(IP3,J1 
55 BOTP(IP3,JP3l = -B0TP(IP3,JP31 

CALL MULT3 (BDTP( 1,1 1 ,S1GH( 1 , 1 ,LHSP 1 ,BDTP( 1 ,71 ,3 ,3,LEP,6,3,61 
CALL MULT? (BDTP(4,41,HATH(1,1,LHSP1,BDTP(4,7),3,3,LEP,6,3,61 
GO TO 60 
50 CALL MULT3 
CALL MULTAD 
00 58 1=1,3 
DO 58 J=l,3 

58 BDTP(1,J1 = -BDTP(I,J1 
60 CONTINUE 
RF70RN 


(PINOT,ROM,BOTP,3,3,3,3,3,61 

(P1N(1,1,L1,DRQM,BDTP,3,3,3,3,3,61 


100 DO 70 1=1,3 
70 WQNdl = -V(I1 

CALL SKEWV3 (W0N,WSK,1,3) 

CALL MULT3 (ROL ,W5K ,BDTQ(4,4 } ,3,3,3,3 ,3,6 1 
B20T = BETAHD(2,11 
B30T = BETAHD(3,n 
DO 75 1=1,3 
DO 75 J=l,3 

75 BDT0(I,J1 = B20T*RP2II,J,11 ♦ B3DT*RP3( I,J,11 

RETURN 

END 


000390 

000391 

000392 

000393 

000394 

000395 

000396 

000397 

000398 

000399 

000400 

000401 

000402 

000403 

000404 

000405 

000406 

000407 

000408 

000409 

000410 

000411 

000412 

000413 

000414 

000415 

000416 

000417 

000418 

000419 

000420 

000421 

000422 

000423 

000424 

000425 

000426 

000427 

000428 

000429 

000430 

000431 

000432 

000433 

000434 

000435 

000436 
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[HDGyP BHGENR 
fFORylS BHGEMR 

COMPILER (XM=1»,CEQUIV=CMNI 
SUBROUTINE BHGENR 

IMPLICIT DOUBLE PREC ISION (A-H.O-Z » 

C 

COMMON /BHBSRD/ 

♦ BH(6,12« 9),BSC6t12*10)«R0L(3t3« 5)tD0L(3, 5) 

COMMON /HANDS / 

♦ HATH(3, 6» 8)*SIGH(3t 6* 8)»HATS(3, 6,10) ,SIGS(3t 6,10) 

COMMON /MAXMUM/ 

♦ NBHAX ,NHMAX,NSPMAX,NHWMAX,NMWBOD,NMDBOD,KHU,KY,KU 

COMMON /NUMBRS/ 

♦ ZRO,ONE,TWO,TRES 

COMMON /PINRP / 

♦ PIN!3,3, 5), RP2I3,3, 5), RP3I3,3, 5) 

COMMON /SPECIF/ 

♦ BETAHI6, 5),B«nAHDC6, 5),AMOI2, 5) ,RH(3,3,2^) ,RS(3,3,20), 

♦ DH(3,28),DS(3,20) ,IM0(3, 5),MM0WC5, 5) ,IFTSMWf 10) , 

♦ NB,NH,NSPT,NOFMO,NDELTA,ITOPOL(2, 5),1RGFLX( 5),IHDATAC7, 5), 

♦ LOCUl 12),LENU«12),NU,NBETA,NLAM,NEQ 

C 

DIMENSION W1I3,3),W2(3,3) 

C 

DATA IlST /O / 

C 

IF HIST .EO. 1) GO TO 100 
IlST = 1 

LR = 2*NHMAX - 1 
JR = 6 ♦ NMOBOO 
DO 5 L=1,LR 
DO 5 1=1,6 
DC 5 J=1,JR 
5 6HII,J,L) = ZRO 
C 

100 00 10 1=1,3 
IP3 = I ♦ 3 
DO 10 J=!,3 
JP3 = J ♦ 3 

BH(I,J,1) = PIN(I,J,1) 

10 BHIIP3,JP3,1) = R0L(I,J,1) 

C 

DC 20 L=2,NH 
LQ = 2*L - 2 
LP = LO ♦ 1 
LR3 = 6*fL-2) ♦ 3 
LR4 = LR3 ♦ 1 
LR5 = LR3 ♦ 2 
LD3 = 7*(L-2) ♦ 3 
L04 = L03 ♦ 1 


-000437 
-000438 
-000439 
000440 
-000441 
000442 
000443 
200444 
000445 
400446 
000447 
000448 
000449 
000450 
000451 
1300452 
000453 
1600454 
1 700455 
1800456 
1900457 
000458 
000459 
000460 
000461 
000462 
000463 
000464 
000465 
000466 
000467 
000468 
000469 
000470 
000471 
000472 
000473 
000474 
000475 
000476 
000477 
000478 
000479 
000480 
000481 
000482 
000483 
000484 
000485 
000486 


! 


] 
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00 25 1*1,3 000487 

00 25 J=l,3 000488 

Wl(J,n * RH(1,J,LR3) 000489 

W2(J,Z) = •»H1I,J,L»5) 000490 

25 BHf J+3,1+3,LP) * -•RHa,J,LR4) 000491 

CALL MULT3 (RHfl ,I ,LP5 I ,Wl ,BH (4,4,L0) ,3,3,3 ,3,3,61 000492 

CALL MULT3 (PIMtl ,1 ,L ) ,W1 ,BH (1,1 ,L0) ,3 ,3,3 ,3,3,6 ) 000493 

CALL MULT3 (W?,RH(4,4,LP ) ,W1 ,3,3,3,3,6 ,3) 000494 

CALL MULT3 (PIN( 1 ,1 ,L) ,W1 ,BH ( 1 ,1 ,LPI ,3 ,3,3,3,3,6 I 000495 

CALL SKEWV3 (DH( !,L03 ) ,W1 ,3,3 ) 000496 

CALL SKEWV3 (DH(1,L04),W2,3,3) 000497 

CALL MULT3 (BH(4,4,LQ ) ,W1 ,BH (4,1 ,L0) ,3 ,3,3,6,3 ,6 > 000498 

CALL m»LT3 (BM(4,4,LP),W2,BH(4,1,LP),3,3,3,6,3,6) 000499 

NOBQ = 170POL(1,LI 000500 

NOBP = ITOPOL(2,L) 000501 

NMQ * IRGELX(NOBQ) 000502 

NMP * IRGFLX(NOBP) 000503 

IF (NMQ ,E0. 01 GO TO 30 000504 

LHS * 2*L - 3 000505 

CALL MULT3 (BH( 1, 1, LQ) ,SIGH( 1 ,I ,LHS ) ,BH( 1 ,7,L0) ,3,3,NMQ,6,3,6) 000506 

CALL MUL”*3 (PH(4,4,L0I ,HATH(1 ,1,LHS) ,BH(4,7,L0),3,3,NMQ,6,3,6I 000507 

30 IF (NMP .EO. 01 GO TO 20 000508 

LHS = ?*L “ 2 000509 

CALL MULT3 (BH( 1, 1,LP ) ,SIGK( 1 , 1,LHS ) ,BH(1 ,7,LP ) ,3,3,NMP ,6,3,61 000510 

CALL MULT3 (BH(4,4,LP ) ,HATH( 1 ,1,LHS ) ,BH(4,7,LP ),3,3,NMP,6,3,6) 000511 

20 CONTINUE 000512 

C 000513 

RETURN 000514 

ENn 000515 


[HOGtP BSGENR 
[FOR. IS BSGENR 

COMPILER f XN=1)*CEQUIV-CMNI 
SUBROUTINE BSGENR 

IMPLICIT DOUBLE PR EC IS ION I A-H. 0-2) 

C 

COMMON /BHBSRD/ 

* BH(6.1?, 9).BS(6,12.1O)«R0Lf3.3» 51.D0L(3. 51 

COMMON /HANDS / 

• HATH(3. 6. 8}»STGHf3. 6. 8I«HATS(3» 6.10) •SIGSI3. 6,10) 

COMMON /MAXMUM/ 

* NBNAX.NHMAX,NSPMAX,NMWMAX,NMNBOD.NMDBOD.KMU,KY,KU 

COMMON /NUMBRS/ 

♦ ZRO.ONE.TMO.TRES 

COMMON /SPECIF/ 

* BETAH(6, 5),BETAHD(6, 5).AM0(2, 5 ) ,RH(3,3,24) ,RS f 3.3,20), 

♦ DH(3.28),DS(3.20).IM0f3. 5).MMOW(5. 5) .IFTSMHClO) , 

* NB,W.NSPT,M0FM0,NDELTA,IT0P0Lf2. 5).IRGFLX( 5).IHDATA[7, 5), 

♦ LOCU( I2).LENUI12),NU.NBETA,NLAM.NE0 
C 

DIMENSION W(3.3) 

C 

DATA IlST / O / 

C 

IF HIST .EO. 1) GO TO 20 
C 

JR = 6 NMDBOD 
00 5 L=1,NSPT 
DO 5 1=1,6 
00 5 J=l,JR 
5 BSd.J.L) = ZRO 
C 

20 00 10 L=I,NSPT 
NOB = IFTSMW(L) 

LF = IRGFLX(NOR) 

IF (LE .EO. 0 .AND. IlST .EO. 1) GO TO 10 

LR2 = 2»L 

DO 15 1=1,3 

IP3 =1+3 

00 15 J=l,3 

JP3 = J ♦ 3 

BSfJ.l.L) = RSfI,J,LR2) 

15 BSfJP3,IP3,L) = RSfI,J,LR2) 

CALL SKEWV3 IDSI1,LR2),W,3,3) 

CALL MULT3 (BSd ,1,L) •W,6Sf4,l,L) ,3,3,3,6,3,6) 

IF CLE .EO. 0) GO TO 10 

CALL MULT3 (BS( 1 ,1, L) ,SIGS(1, 1,L ),BS t 1 ,7,L) ,3,3,LE,6,3,6 ) 

CALL MULT3 (BSf l.l.L) .HATSIl ,1 ,L) ,BS(4 ,7,L ) ,3,3,LE,6,3,6) 

10 CONTINUE 
C 


-000516 

-000517 

-000518 

000519 

-000520 

000521 

000522 

200523 

000524 

400525 

000526 

000527 

000528 

000529 

000530 

1600531 

1700532 

1800533 

1900534 

000535 

000536 

000537 

000538 

000539 

000540 

000541 

000542 

000543 

000544 

000545 

000546 

000547 

000548 

000549 

000550 

000551 

000552 

000553 

000554 

000555 

000556 

000557 

000558 

000559 

000560 

000561 

000562 

000563 

000564 

000565 


IlST = 1 

RETURN 

END 


000566 

000567 

000568 


{ I I I I 1 I I i 
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tHOGfP BTABA 


-000569 

r FOR* IS BTABA 


-000570 


COMPILER (XH=1)*fEQUIV=CMNl 


-000571 


SUBROUTINE BTABA ( AZ *B *NRB*NCB»KAZ*KB 1 


000572 


IMPLICIT DOUBLE PRECISION IA-H,0-Z> 


-000573 


DIMENSION AZ(KAZtl)* BIKB* l)*Wfl50) 


7200574 


DATA NOT / 6/ 


000575 

c 



000576 

c 

TRIPLE MATRIX PRODUCT. B (TRANSPOSE) ♦ A ♦ B = Z. 


000577 

c 

A MUST BE SYMMETRIC TO GET CORRECT ANSWER. 


000578 

c 

Z WILL BE SYMMETRIC. UPPER HALF CALCULATED* REFLECTED TO LOWER HALF. 

000579 

c 

USES TWO WORK SPACES. RESULT (Z) IS PLACED IN A. 


000580 

c 

AZ MUST BE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 

000581 

c 

LARGER OF A OR Z. 


000582 

c 

CALLS forma subroutine ZZBOMB. 


000583 

c 

THE MAXIMUM SIZES ARE 


000584 

c 

NRB = XXX 


000585 

c 

NCB = XXX 


000586 

c 

DEVELOPED BY W A BENFIELD. MAY 1972. 


000587 

c 

LAST REVISION BY R A PHILIPPUS. JUNE 1972. 


000588 

c 

MODIFIED FOR USE IN GSFC PROGRAM BY CARL BODLEY* MAY 1974 


000589 

c 



000590 

c 

SUBROUTINE ARGUMENTS 


000591 

c 

AZ » INPUT INNER MATRIX. SIZE(NRB*NRB ) . 


000592 

c 

= OUTPUT RESULT MATRIX. SIZE (NCB *NC6 ) . 


000593 

c 

B = INPUT OUTER MATRIX. SIZE(NRE*NCB )„ 


000594 

c 

NRB = INPUT NUMBER OF ROWS OF MATRIX 6* SIZE OF MATRIX A. 

MAX=150. 

000595 

c 

NCB s INPUT NUMBER OF COLS OF MATRIX B* SIZE OF MATRIX Z. 

MAX=150. 

000596 

c 

KAZ = INPUT POW DIMENSION OF AZ IN CALLING PROGRAM. 


000597 

c 

KB = INPUT »OW DIMENSION OF B IN CALLING PROGRAM. 


000598 

c 



000599 


IF (NRB. GT. 150 .OR. NCB.GT.150 .OR. NRB .GT.KAZ .OR. NCB 

•GT.KAZ) 

7300600 


♦ GO TO 999 


000601 

c 



000602 


DO 20 1=1* NRB 


000603 


DO 5 K=1*NRB 


000604 


5 W(K) = AZ(T*K) 


000605 


DO 20 J=1»NCB 


000606 


S = O.D 0 


000607 


00 10 K=1*NPB 


000608 


10 S = S ♦ W(K)*B(K*J) 


000609 


20 AZ(1*J) = S 


000610 

c 



000611 


DO 30 J=1*NCB 


000612 


DO 25 I=1*J 


000613 


W(I) = O.D 0 


000614 


DO 25 K=1*NRB 


000615 


25 W(I) = W(I>+B(K*I)«AZ(K*J) 


000616 


DO 30 1=1* J 


000617 


AZ(I*J) = W(I) 


000618 


1 


i 




I 


19 


30 AZfJtl) = Win 000619 

RFTURN 000620 

C 000621 

999 WRITE INOTvlOOn 000622 

1001 FORMAT flH It 31 HERR OR IN BTABAt PROGRAM STOPPED) 000623 

STOP 000624 

END 000625 



onnoooonoonoono 


1 


1 
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(HDG»P CANCOR 
[FOR, IS CAWCCIR 

COMPILFR (XM=1>,|EQUIV=CMNI 
SUBROUTINE CANCOR CR» 

IMPLICIT DOUBLE PREC ISI0NIA-H»0-Z) 

THIS ROUTINE CANCELS OUT THF ZERO, REAL, AND THE COMPLEX ROOTS THAT AP 
COMMON TO THE NUMERATOR AND DENOMINATOR OF THE TRANSFER FUNCTION R. 

RCl) = NUMBER OF REAL ROOTS IN THE NUMERATOR 

RC2I = NUMBER OF COMPLEX PAIRS IN THF WJMERATOR 

RC3) = NUMBER ZFRO ROOTS IN THE NUMERATOR 

RI4) = NUMBER OF REAL ROOTS IN THE DENOMINATOR 

RIB) = NUMBER. OF COMPLEX PAIRS IN THE DENOMINATOR 

P(6) = NUMBER OF ZERO ROOTS IN THE DENOMINATOR 

- — RI7) = GAIN 

RI8)-..R(I) = NUMERATOR REAL ROOTS ARRAY 

R(l+l)...RfJ) = NUMERATOR COMPLEX PAIRS ARRAY 

R(J+I)-..RIK) = DENOMINATOR REAL ROOTS ARRAY 

RfK+l..,Rm = DENOMINATOR COMPLEX PAIRS ARRAY 

DIMENSION Rill 
NR=R|1I+.0001D0 
NCP=RI2)+.000100 
MRsR 14)4^.000100 
MCP=R{5)+. 000100 
KK*7+NR +MR 4-2* I NC P+MCP ) 

N = 7 ♦ NR 

IFIINR.EO.OI.OR.IMR.EQ.O) ) GO TO 160 
J=84N«>4-2*NCP 
K=J-1+MR 
NNssO 

DO 140 1=8 ,N 
II = I-HN 
DO 100 JJ=J,K 
JJJ=JJ 

IF|DABSIR|II)/R|JJJ)-1. DO). IT. 1.00-7) GO TO 110 
100 CONTINUE 
GO TO 140 

110 DO 130 L=I1,KK 

IFIL.GE.IJJJ-D) GO TO 120 
RIL)=RIL+1 ) 

GO TO 130 
120 RIL)=RIL4-2 ) 

130 CONTINUE 
KK=KK-2 
J=J-1 
K=K-2 
NN=NN+1 

IFIINN.EO.NR I.OR.INN.FQ.MR)) GO TO 150 
140 CONTINUE 


-000626 

-000627 

-000628 

000629 

-000630 

000631 

000632 

000633 

000634 

000635 

000636 

000637 

000638 

000639 

000640 

000641 

000642 

000643 

000644 

000645 

000646 

000647 

000648 

000649 

000650 

000651 

000652 

000653 

000654 

000655 

000656 

000657 

000658 

000659 

000660 

000661 

000662 

000663 

000664 

000665 

000666 

000667 

000668 

000669 

000670 

000671 

000672 

000673 

000674 

000675 
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150 RC1)=RC1I-DFL0AT(NN» 

R(4)=Rf4)-DFL0AT(NN) 

NR®NR-NN 

HR=MR-NN 

160 TFf (NCP.FQ.O).nR.(HCP.EO.OII GO TO 230 
NNN=8+NR 
M=NNM-1+2*NCP 
J=N-*-l+MR 
K=J-1+24MCP 
NN=0 

DO 210 I=NNN,N,2 

IIsI-2*NN 

DO 170 JJ=J,K,2 

TFfIRf II).FO.RfJJJI).AND.(RfII+l).EO.R( JJJ-t^im GO TO 180 
170 CONTINUE 
GO TO 210 

180 DO 200 L=II,KK 

IFCL-GE.fJJJ-2ll GO TO 190 
R(L)=RIL+2) 

GO TO 200 
190 RIL>=RIL+4) 

200 CONTINUE 
KK=KK“4 
J=J-2 
K=K~4 
W=NN+1 

TF(fNN.EQ.NCP) .OR.fNN.EQ.MCPI) GO TO 220 
210 CON-^INUE 

220 R(2)=PI2»-0FL0ATfNN) 

R(5I=R(5I-D'=L0AT(NN) 

230 X=0MINl(R(3),Rr6}) 

RC3»=R!3)-X 

R(6)=RC6)-X 

RETURN 

END 


000676 

000677 

000678 

000679 

000680 

000681 

000682 

000683 

000684 

000685 

000686 

000687 

000688 

000689 

000690 

000691 

000692 

000693 

000694 

000695 

000696 

000697 

000698 

000699 

000700 

000701 

000702 

000703 

000704 

000705 

000706 

000707 

000708 

000709 

000710 

000711 


I 
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[HDGyP COMEMT 
t FOP, IS COMEMT 

COMPILER (XMs1),(E0UIV-CMN) 

SUBROUTINE COMEMT 
DIMENSION IREMPK(13I 
DATA NIT.NOT /5,6/ 

C 

C READ COMMENT CARDS AND PRINT THEM UNDER PAGE HEADING OF FORMA 
C SUBROUTINE PA6EH0. COMMENT CARDS MAY HAVE ANY KEYPUNCH SYMBOL 
C IN CARD COLUMNS 1-78, 

C IF IT IS DESIRED TO HAVE ANY GIVEN COMMENT CARO PRINT ON A NEW 

C PAGE, SUPPLY THE LETTER P IN COLUMN 80 ON THAT CAPO, 

C ROUTINE IS ENDED BY SUPPLYING A CARO WITH ZEROS IN COLUMNS 1 THRU 10, 

C CALLS FORMA SUBROUTINE PAGEHD. 

C CODED BY RF MRUDA, MARCH 1966, 

C LAST MODIFICATION BY J ERNST. JUNE 1971, 

C 

1001 FORMAT (13A6,1X,A1) 

2001 FORMAT {///) 

2002 FORMAT (2?X,13A6) 

C 

N = 0 

1 READ f NIT, 10011 (IREMRK ( I ) ,1=1 ,13 } ,IPGHO 
IF flRFMRK(l) .EO, 6HOOOOOOI RETURN 

N = N+1 

IF tN.NE.l .AND, IPGHD.NE.IHP » GO TO 2 
CALL PAGEHD 
WRITE (NOT ,2001) 

M = 1 

2 IF IN .EO. 50) N = 0 

WRITE CN0T,2002) ( IREMRK( I ) ,1=1 ,13) 

GO TO 1 
END 


-000712 

-000713 

-000714 

000715 

000716 

-000717 

000718 

000719 

000720 

000721 

000722 

000723 

000724 

000725 

000726 

000727 

000728 

000729 

000730 

000731 

000732 

000733 

000734 

-000735 

000736 

-000737 

000738 

000739 

000740 

000741 

000742 

000743 

000744 
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CHOGtP CONTRL 
fFORylS CONTRL 

COMPILER (XM=1I,IECUIV=CMN) 

SUBROUTINE CONTRL 

IMPLICIT DOUBLE PRECISION (A-H,0-2» 

C 

COMMON /BHBSRO/ 

♦ 6H(6,12, <»),B$(6,12»I0),R0L(3»3» 5)«DOLf3» 51 

COMMON /CONPAR/ 

♦ CNTOTA(IOO) 

COMMON /lOSIZE/ NX,NY,NDLTA,NXSSfNBT0,NJQ,NY2,N02 
COMMON /SPECIF/ 

♦ BETAH(6, 5)»BETAHD(6t 5»,AMOC2, 5 ) *RH(3 t3 *2A ) »RS f 3«3 *20 ) t 

♦ DHf3»28)tDS(3,20)»IM0(3t 5),NM0W(5, 5) t IFTSMWdOlt 

♦ NBtNH,NSPT,NOFMO,NDELTAf IT0P0l(2r 5>,IRGFLXC 5)tIHDATA(7» 51, 

♦ LOCU( 12 ) ,LENU 112 ) ,NU ,NBETA ,NLAM ,NEQ 

COMMON /TIMESS/ 

♦ STARTT,OELTAT,T,ENDT,TMST 

COMMON /VECTOR/ 

♦ Y(250),Y0TI250) 

CCCCCCC THIS COMMON IS TRANSFER BETWEEN CONTRL AND SHAFTT ONLY 

COMMON /WHEEL / 

♦ CLM(4) 

C 

DIMENSION TQf6),T0D(6),RHD(3),THADW(3) 

DIMENSION CPLYdO.A), KPLYC2) , UIC2» 

DATA ICT4/0/, RHD / 0«00, O.DO, 0.00 / 

DATA T1,T?,T3,T4,0THE/ 

♦ .200, 1.200, .700, 1.700, 1.0471975500 / 

DATA NPLY, KRY, KCV/ 0, 10, 4/ 

DATA II ST/ 0 / 

ALIM(U,V) = DMAX1(-V,DHIN1(U,V) ) 

C 

CCCCCCCCCC 

CCCCCCCCCC 

CCC THE FOLLOWING STATEMENTS MUST ALWAYS BE IN CONTRL.. 

IF CIIST .NE. 01 GO TO 110 
II ST = 1 

IF (NPLY .EQ. 0) GO TO 106 
CALL ZERO fCPLY,KRY,KCY,KRY) 

DO 105 K=1,NPLY 
K2=2*K~1 

105 CALL READ (CPLY(1,K2 ),KPLY(K» ,N2,KRY,KCYI 
CALL WRITE (CPLY,KRY,KCY,4HCPLY,KRY) 

106 CONTINUE 
NOLTA = NOELTA 

LOEL = L0CU(2*NB+2> ~ 1 
110 CONTINUE 
NXSS - 3 
NBTQ = 3 


-000745 

-000746 

-000747 

000748 

-000749 

000750 

000751 

200752 

000753 

9500754 

000755 

000756 

1600757 

1700758 

1800759 

1900760 

000761 

000762 

000763 

2000764 

000765 

000766 

000767 

000768 

000769 

000770 

000771 

000772 

000773 

000774 

000775 

000776 

000777 

000778 

000779 

000780 

000781 

000782 

000783 

000784 

000785 

000786 

000787 

000788 

000789 

000790 

000791 

000792 

000793 

000794 



IF fNDELTA .FQ. 0» RETURN 
CCCCCCCCCCC CCC 

CCCC NOTE— THIS SUBROUTINE MUST ESTABLISH NDLTA.NXSS AND NBTQ 

CCCCCCCCCCC 

C 

CCCC ESTABLISH THE O/DTIOELTASI 
C 

CCCCCCCCCC 

CCCC NOTE — THIS SECTION IS TYPICAL OF USE OF TFPLY. 

CCCCCCCCCC 

C 

IF IMPLY .EO. 0» GO TO 116 
L = lOEL+l 
DO 115 K=1*NPLY 
K2 = 2*K-1 

CALL TFPLY I CPLYIl *K2) «CPLYf 1,K2<^1) ,UI I K) »X tKPLY(K) «L ) 

L = L+KPLYIK) - 1 

115 CONTINUE 

116 CONTINUE 
C 

CCCCCCCCCC 

ICTA = ICTA ♦ 1 
lA = IICTA-I)/A 
lAA = IICTA-2J/A 
IFLAG = TA - lAA 
DO 6 1=1*3 
6 THADWII) = Y I 6+1 I 
DO 5 1=1,6 
5 TQin = YILDEL^II 
C 

C WHEEL 1 (ROLL INERTIA WHEEL CONTROL TOROUEI 

C DEFINE DIFFERENTIAL EQUATIONS FOR ROLL CONTROL LOOP 

C 

U1 = 57.2<>58D0«R0L(3,2»l)/R0L(3*3,n 
U5 = ALIM(TQ(5),29.DO) 

U2 = 2*17DO*Ul - U5 

U3 = ALIM(1.1D0*U2»I.17D0I 

T00I5) = (1.00/ee.DO)*f-TOI5) ♦ (Y/1.1DOIAU3) 

U6 = ALIM(5*U3,1.68DO) 

U8 = ALIM(T0(6),1.<»D0> 

IF IIFLAG .EQ. 01 GO TO 32 
UU = DABSIU8) 

IF (UU.GT.l.DO) GO TO 30 
IF IUU,LT.0.5D0) GO TO 31 
U9 = RHOIl » 

GO TO 10 

30 UR = ua/uu 
GO TO 10 

31 U9 = 0.00 
GO TO 10 


000795 
000796 
000797 
000798 
000799 
000800 
000801 
000802 
000803 
0008 OA 
000805 
000806 
000807 
000808 
000809 
000810 
000811 
000812 
000813 
000 8 lA 
000815 
000816 
000817 
000818 
000819 
000820 
000821 
000822 
000823 
00082A 
000825 
000826 
000827 
000828 
000829 
000830 
000831 
000832 
000833 
00083A 
000835 
000836 
000837 
000838 
000839 
0008A0 
0008A1 
000 8 A2 
0008A3 
000 8AA 


nnno noon onoo 


i 


25 


32 U9 = RHDfl) 

GO TO 33 

10 RHD(l) s U9 

33 CONTINUF 

TOD(A) = C-T0I6) ♦ 2.500*fU6-U9n/.5D0 

1500 RPM = 157.0795 RAD/SEC 
6 INCH90Z = .03125 FT9LBS 

IF CDABSfTHADWmi.GT. 157.0795D0I U9 = O-DO 
CLMIll = .031?5D0*U9 - 5.0-05*THADWn » 

WHEEL 2 (PITCH INERTIA WHEEL CC5NTR0L TORQUE) 

DEFINE- DIFFERENTIAL EQUATIONS IN PITCH CONTROL LOOP 

U1 = -57.295800*R0L(3,1,1)/R0LI3,3,1) 

U5 = ALIMfTQd )tl6.4D0) 

U2 = 2.17D0*U1 - U5 

U3 = ALIPf .82D0*U2,1.17D0) 

TOD(l) = (-TQC1) ♦ U3*(7/.82D0))/50.D0 
U6 = ALIM(5*U3,1-68D0) 

U8 = ALIM(T0(2)tl.9D0) 

IF CIFLAG.EO.O) GO TO 14 
UU * DAPS (08) 

IF (UU.GT. l.DO) GO TO 15 
IF (UU.LT.0.5D0) GO TO 16 
09 = RHD(2) 

GO TO 12 

15 U9 = U8/U0 
GO TO 12 

16 U9 = o.DO 
GO TO 12 

14 U9 * RHD(2) 

GO TO 13 

12 RHD(2) s U9 

13 CONTINUE 

TQD(?) * (-TQ(2) ♦ 2.5D0*(U6 - U9))/.500 
IF (nABS(THADW(2)).GE. 157.079500) U9 * 0 
CLM(2) = .0312500*09 - 5.D-05*THADW(2) 

WHEEL 3 (YAW INERTIA WHEEL CONTROL TORQUE) 

DEFINE DIFFERENTIAL EQUATIONS FOR YAW CONTROL LOOP 

U1 = 57.295800*R0L(2fltl)/R0L(2t2fl) 

U2 = ALIH(U1,2.00) 

U6 = ALIH(T0(3), 29.00) 

U3 - ?.17D0*U2 - U6 

U4 = ALlM(l.A7D0*U3t 1.1700) 

TQD(3) = (1. 00/88. 00)*(~TQ(3) + (9/1 .4700 )*U4) 

U7 = ALIN( 5*04,1.6800) 


000845 

000846 

000847 

000848 

000849 

000850 

000851 

000852 

000853 

000854 

000855 

000856 

000857 

000858 

000859 

000860 

000861 

000862 

000863 

000864 

000865 

000866 

000867 

000868 

000869 

000870 

000871 

000872 

000873 

000874 

000875 

000876 

000877 

000878 

000879 

000880 

000881 

000882 

000883 

000884 

000885 

000886 

000887 

000888 

000889 

000890 

000891 

000892 

000893 
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U9 s: ALIMf T0f4)»1.9D0 ) 000895 

IF tIFLAG.FO.O) GO TO 20 000896 

UU = 0ABSCU91 000897 

IF fUU.GT.l.DOl 60 TO 21 000898 

IF (UU.LT. 0.5D0) GO TO 22 000899 

010 = RH0(3» 000900 

GO TO 18 000901 

21 UlO = U9AI0 000902 

GO TO 18 000903 

22 UlO = O.DO 000904 

GO TO 18 000905 

20 010 = RH0f3» 000906 

GO TO 24 000907 

18 RH0C3I = UlO 000908 

24 CONTINOF 000909 

T0D<4> = t-T0t4} ♦ 2.5D0*IU7 - 010)1/. 500 000910 

IF fOABSCTHAOHISn .GT. 157.079500) UlO = 0.00 000911 

CLM(3) = .0312500*010 - 5 .D-05*THADHf 3 ) 000912 

C 000913 

DO 34 1=1,6 000914. 

34 YDTfLOFL+I) = TOOIl) 000915 

YDTILOEL+7) = YI16) 000916 

SK4 r: CMTOTACNDELTA+l) 000917 

DK4 = CNTDTA(NDELTA+2) 000918 

CLM(4) =-f SK4*Y(L0FL+7) ♦ 0K4*Y0T|lDEL+7) ) 000919 

C 000920 

RETURN 0009?! 

END 000922 
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CHOG» 

P CREA 

-000923 

IFOR, 

IS CREA 

-000924 


COMPILER IXM=1),(EQUIV=CMN| 

-000925 


SUBROUTINE CRE A ( NR EC 3 , N J ,NE «UVEC • A tB » KA *K 6 1 KW S I 

000926 


IMPLICIT DOUBLE PREC1SI0NCA-H,0-Z) 

-000927 

C 


000928 


COMMON /NUHBRS/ ZRO,ONE»TWOfTRES 

000929 


COMMON /TAPENO/ NTAPEl *NTAPE2 ,NTAPE3 

000930 

C 


000931 


DIMENSION A( KA »I ) »B ( KB »1 ) tUVEC ( I ) 

000932 

C 


000933 


CALL ZFR0(A,9,NEtKA) 

000934 


FETCH M*HX 

000935 


CALL FETCH.(NTAPE3, 1 •NREC3»B»NJ«NE»KB) 

000936 


CALL SATB(-ONEtUVECt6,Af6,lltNJ,I,NE,KWS»KB.KA) 

000937 

c*** 

FETCH M*HY 

000938 


CALL FETCH (NTAPE3, 4,NREC3»BtNJtNE tKB) 

000939 


CALL SA^B( 0NEfUVEC»B,At3»l ItNJfltNEyKWStKBtKA) 

000940 


FETCH M*HZ 

000941 


CALL FETCH (NTAPE3, 7*NREC3vB»NJ*NEyKB) 

000942 


CALL SATB(-ONE«UVECyB»A{2«UtNJ«l,NE*KWStKB»KA) 

000943 


DO 49 J=1,NE 

000944 


A|4,J| = -A(2,J) 

000945 


A(7,J) =: -A(3.J) 

000946 

49 

AC8tJ» = -A(6,J» 

000947 

C 


000948 


CALL WRITE (At9tNEt4HAC0FyKAI 

000949 


WRITFINTAPEl J ( ( A ( It J ) • J>1*NE ) * 1=1 *9 ) 

000950 

C 


000951 


RETURN 

000952 


END 

000953 
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fHDG.P CREADO 
tFORtlS CREADO 

COMPILER (XM=1),(E0UIV=CMN) 

SUPROUTINF CRFA00(NREC3tNJ*NEtUVECtA*B»C«WS»AMUtKAtKB»KC»KWS»KAMU) 
IMPLICIT DOUBLE PRECISIDN(A-H,0-Z> 

C 

COMMON /NUMBRS/ ZROtONE,TWOtTRES 
COMMON /TAPENO/ NTAPEl ,NTAPE2,NTAPE3 
C 


DIMENSION A(KAfl}fP(KB»ll«C(KC«: 
C 

C*** FfTCH M*HX *H*HY,M*HZ 

CALL FFTCH(NTAPE3» 1 tNRFC3,A,NJ 
CALL FETCH (NTAPE3, A,NREC3tBtNJ, 
CALL FETCH(NTAPE3f 7,NREC3,CtNJ, 
CALL SATBJ ONE,UVEC ,AtAMUC4, 

CALL SATBC ONE,UVEC ,BtAMU(5, 

CALL SATB( ONE.UVEC ,CfAMU(6, 

CALL SATB( ONE.WS ( 1 * 13 » ,A, AMU(2i 

CALL SATB(-ONEtWS(l,12),AtAMUC3, 
CALL SATBI-ONE,WSCl,13»,B,AMU(l, 
CALL SATBC ONE,WS ( 1 t H ) .B t AMU C3, 
CALL SATBC ONE,WS C 1 tl2> ,C »AHUC 1 
CALL SATB(-CNE,WSI1,11),C lAMUCZ, 
C*** FETCH SY*SIGX,SZ*STGX 

CALL FETCH CNTAPE3, 13 ,NREC3tAfNJ 
CALL FETCH CNTAPE3»14,MREC3,BtNJ 
CALL SATBC ONE.UVEC ,AfAMUC6 
CALL SATBC -ONE tUVEC ,BtAMUC5 
CALL SATBC ONEtWS C 1 t 12) ,A,AMU C 1 
CALL SATBC ONE tWS ( 1 t 13 ) tB t AMU C 1 
CALL SATBC-ONF.WSCl.ll)fA,AMUC2 
CALL SATBC-ONE,WSClf ll),BtAMUC3 
C*** FETCH SX*SIGY,SZ*SIGY 

CALL FETCH CNTAPE3,!8fNREC3tAfNJ 
CALL FETCHCNTAPE3,19,NREC3tBtNJ 
CALL SATBC -ONEfUVEC tAtAMUC6 

CALL SATBC CNE*UVEC ,B,AMUC4 

CALL SATBC-0NE,WSC1 ,12),A,AMUC1 
CALL SATBC ONE.WS C If 13) ,B , AMU C 2 
CALL SATBC ONE,WSClf 11 ),A,AMUC2 
CALL SATBC-ONE,WSClfl2),BtAMUC3 
C*** FETCH SX*SIGZfSY*SIGZ 

CALL FETCH CNTAPE3,23,NREC3f AfNJ 
CALL FETCH CWTAPE3, 24, NREC3,B,NJ 
CALL SATBC ONE.UVEC .AfAMUCS 

CALL SATBC -ONEfUVEC .B,AMUC4 

CALL SATBC-ONEfWSC1.13)fA.AMUCl 
CALL SATBC-ONEfWSC1.13).B.AMUC2 
CALL SATBC ONE.WS C 1 . 11 ) . A . AMUC 3 


) f WS CKWSf 1 ) fAMUCKAMUf 1 ) .UVEC C 1 ) 


>NEfKA) 

NE.KB) 

NEfKC) 

7)fNJf l.NEfKWSfKA.KAMU) 
7)fNJ. IfNEfKWSfKBfKAMU) 
7)fNJ, IfNE.KWSfKCfKAMU) 
7).NJf l.NE.KWS.KAfKAMU) 
7)fNJf l.NEfKWSfKA.KAMU) 
7).NJf IfNEfKWSfKBfKAMU) 
7)fNJf IfNEfKWSfKBfKAMU) 
7)fNJf IfNEfKWS.KCfKAMU) 
7)fNJf IfNEfKWS.KCfKAMU) 

>NEfKA) 

»NEfKB) 

,7)fNJf l.NEfKWSfKA.KAMU) 
r7).NJf IfNEfKWSfKBfKAMU) 
>7)fNJf l.NEfKWSfKA.KAMU) 
»7)fNJf IfNE.K) SfKRfKAMU) 
r7)fNJf l.NEfKWSfKA.KAMU) 
-7).NJf IfNEfKWSfKBfKAMU) 

)NE.KA) 
rNE fKB ) 

>7)fNJf l.NEfKWSfKA.KAMU) 
>7)fNJf IfNEfKWSfKBfKAMU) 
>7)fNJf l.NEfKWSfKA.KAMU) 
►7)fN».». IfNEfKWSfKBfKAMU) 
>7)fNJf lfNEfKWS.,KAfKAMU) 
,7)fNJf IfNEfKWSfKBfKAMU) 

>NE.KA) 

,NEfKB) 

r7).NJf IfNE.KWSfKA.KAMU) 
r7)fNJf IfNEfKWSfKBfKAMU) 
r7).NJf IfNEfKWSfKAfKAMU) 
r7).NJf IfNEfKWSfKBfKAMU) 
>7)fNJf IfNEfKWSfKAfKAMU) 


-000954 

-000955 

-000956 

000957 

-000958 

000959 

000960 

000961 

000962 

000963 

000964 

000965 

000966 

000967 

000968 

000969 

000970 

000971 

000972 

000973 

000974 

000975 

000976 

000977 

000978 

000979 

000960 

000981 

000982 

000983 

000984 

000985 

000986 

000987 

000988 

000989 

000990 

000991 

000992 

000993 

000994 

000995 

000996 

000997 

000998 

000999 

001000 

001001 

001002 

001003 
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C**« 


c**# 




c*** 


c 

c 


CALL SATB( ONE »WS ( 1 » 12) »B »AMU(3 t?) »N J, 
FETCH SY*HX,SZ*HX 

CALL FETCH(NTAPE3* 2tNBEC3tAfNJ»NE»KA) 
CALL FETCH (NTAPE3, 3 ,NREC3tB,NJ,NE ,KB ) 
CALL SAT6( ONEtUVEC ,B,AMU(2,7) ,NJ, 

CALL SATBC-€iNE,UVEC »AtAMU(3»7) ,NJt 

FETCH SX*HY,SZ»HY 

CALL FETCH CNTAPESr 5tNREC3*AtNJ,NE,KA) 
CALL FETCH CNTAPE3. 6 ,NP.EC3 ,B,NJ ,NE ,KB ) 
CALL SATE(-ONE,UVEC tB ,AMU( 1 ,7) ,NJ, 
CALL SATB< ONE,UVEC »AtAMU(3,7) 
FETCH SX*HZ*SY»HZ 

CALL FETCHINTAPE3* R ,NREC3 ,At NJ,NE ,KA ) 
CALL FETCH.(NTAPE3, 9tNREC3»BfNJ,NE,KB) 
CALL SATBf ONE ,UVEC ,B tAMUCltT) ,NJ, 
CALL SATP{-ONE,UVEC ,A ,AMU(2,7) 
FETCH JXX*SIGX,JXY*SIGX.JXZ*SIGX 
CALL FETCHINTAPE3tl0fNREC3,AtNJ,NE,KA) 
CALL FETCH (NTAPE3, 11 fMREC3,B,NJ,NF,KR ) 
CALL FETCH (NTAPE3, 12 »NREC3 ,C»NJ,NE,KC > 
CALL 5ATB{ ONE,UVEC ,A,AMUI1 ,7) ,NJ, 

CALL SATBC-ONE.UVEC ,B,AHU(2,7) ,NJ, 

CALL SATBf -ONE ,UVEC ,C »AMU(3,7) ,NJ* 

FETCH JXY*SIGY,JYY*SIGY,JYZ*SIGY 
CALL FETCH(NTAPE3,15,NREC3tA,NJ»NE,KA) 
CALL FETCH (NTAPEBt 16 tNREC3,B,NJ,NEtKB) 
CALL FETCH (NTAPE3 , 17 tNREC3,C,NJ ,NE,KC ) 
CALL SATBf -ONE, UVEC ,A,AMUf 1 ,7) ,NJ, 

CALL SATBf ONE,UVEC ,B ,AMU(2,7) ,NJ, 

CALL SATBf -ONE, UVEC ,C , AMUf 3,7 ) ,NJ, 
FETCH JXZ*SIGZ,JYZ*SIGZ,JZZ*SIGZ 
CALL FETCHfNTAPE3,20,NPEC3,A,NJ,NE,KA) 
CALL F ETCH f NTA PE 3 , 2 1 ,N«» EC 3 , B , N J ,N E ,K B ) 
CA LL FETCH f NTAPE3, 22 ,NREC3 ,C,NJ ,NE ,KC ) 
CALL SATBf -ONE, UVFC , A ,AMUf 1 ,7) ,NJ, 

CALL SATBf -ONE, UVEC ,B ,AMU(2,7 ) ,NJ, 

CALL SATBf ONE,UVEC ,C ,ANUf 3 ,7 ) ,NJ , 


1,NE,KWS,KB,KAHU) 

l,NE,KVfS,KB,KAHU) 

l,?iE,KWS,KA,KAMU) 


1,NE,KWS,KB,KAMU) 

1,NE,KWS,KA,KAMU) 


l,NE,KVfS,KB,KAMU) 
!,NE, KWS,RA,KAHU) 


1,NE,KWS,KA,KAMU) 

1,NE,KWS,KB,KAMU) 

1,NE,KWS,KC,KAMU) 


1,NE,KWS,KA,KAMU) 

1,NE,KWS,KB,KAMU) 

I,NE,KWS,KC,KAMU) 


1,NE,KHS,KA,KAMU) 

1,NE,KWS,KB,KAMU) 

1,NE,KWS,KC,KANU) 


CALL WRITE f AMUfl ,7 ) ,3 ,NE,6HDOCOEF ,KAMU ) 
CALL WRITEfANU14,7),3,NE,6HA0C0EF,K.AMU) 


RETURN 

END 


001004 

001005 

001006 

001007 

001008 

001009 

001010 

001011 

001012 

001013 

001014 

001015 

001016 

001017 

001018 

001019 

001020 

001021 

001022 

001023 

00102 ^ 

001025 

001026 

001027 

001028 

001029 

001030 

001031 

001032 

001033 

001034 

001035 

001036 

001037 

001038 

001039 

001040 

001041 

001042 

001043 

001044 

001045 

001046 
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[HDG«P CREB 
[FOR » IS CREB 

COMPILER CXM=ntfEOUIV=CHN» 

SUBROUTINE CRER(NREC3,NREC2fNJtNEt A»BfHSf KA»KB»KWS) 
IMPLICIT DOUBLE PRECISI0NlA-H,0-Z) 

C 

COMMON /NUMBRS/ ZROt ONE.TWOtTRES 
COMMON /TAPENO/ NTAPFl ,NTAPE2tNTAPE3 
C 

DIMENSION AtKAtDfBlKBfl) «WS(KWStl) 

C 

CALL ZER0(B,6,NE,KBI 

FETCH MPRHOXtM^RHOYfM^RHOZ 

CALL FETCHtNTAPE3t25tNREC3fA(l,l>,NJ,l,KA) 

CALL FETCHCNTAPE3,26,NREC3,A(l,2)tNJfl,KA> 

CALL FETCH INTAPE3,27fNREC3,A( It 3) ,NJ,ltKA) 

DO 52 I=1,NJ 

WS(I« 8) - WSfIt 8) + A(I»1) 

WS(1, 9) = WSCl, 9) ♦ Afl,2) 

52 HS(ItlO) = WSUvlOl ♦ A(lt3» 

C^99 FETCH HX 

CALL FETCHCNTAPE2, 5*NREC2tAtNJ»NEtKA) 

CALL SATB(nNE»WSfl, 8) tA^B (2t1 ) tNJ »1 tNE tKWS fKA»KB I 
CALL SATPCONE.WSfl, 8 ) ,A»B ( 3« 1 ) »NJ,1 ,NE»KWS*KA,KB ) 
CALL SATB<0NE»MS(1» 9) ,AtBf4, 1 ) ,NJ,1,NE »KWS»KA*KB) 
CALL SATB ( ONE.WS (1 *10 ) « A«B f 5, 1 > ,NJ ,1 ,NE ,KWS ,XA ,KB I 
C*** FETCH HY 

CALL FETCH CNTAPE2, 6,NREC2tAtNJtNE,KA) 

CALL SATBf ONE,WStl» 91 . A«B( 1 ,1 ) »NJ*1 *NE *KWS «K A«KB 1 
CALL SATB(ONE»WSClt 91 ,A*B( 3« 1) •NJ«1*NE »KWS*KA«KB 1 
CALL SATBf ONE.WS (1 » 8 1 .A. Bf 4.1 1 ,NJ*1 «NE *KWS .KA.KB 1 
CALL SATBf ONE.WS fl .10 1 * A.Bf 6. 1 1 .NJ.l .NE .KHS.KA.KB 1 
C*** FETCH HZ 

CALL FETCH fNTAPE2, 7.NREC2.A,NJ.NE.KA1 
CALL SATBfONF.WSfl .101 .A.Bf 1.1 1 »NJ .1 .NE .KHS.KA.KB 1 
CALL SATBfONE.WSfl.!01.A»Bt2.11.NJ.l,NE.KWS.KA.KBl 
CALL SATBf ONE.WSfl . 8 l.A.B f 5. 1 1 .NJ.l. NE .KHS.KA.KB 1 
CALL SATBf ONE.WSfl . 91 .A. B f 6. 11 .NJ.l. NE. KHS.KA.KB 1 
C 

CALL WRITEfB.6.ME.4HBC0F.KBl 
HR ITEf NTAPFl 1 f fBf 1. J 1 . J=^l . NE 1 . 1=^1 .61 
C 

RETURN 

END 


-001047 

-001048 

-001049 

001050 

-001051 

001052 

001053 

001054 

001055 

001056 

001057 

001058 

001059 

001060 

001061 

001062 
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CHDG 

fFOR 

C 

C 

C 

C*** 

C*** 

C*** 

C*** 

€♦♦♦ 

C 

C 

C*** 

c*** 

c*** 

c*** 

c 

c 
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P CREC 
IS CREC 

COMPILER f XM=l)t(FQUIV=CHN) 

SUBROUTINE CRECINREC3tNREC?tNJ»NE>A«B>C«AMUfKA«KB»KC,KAMU) 
IMPLICIT DOUBLE PREC1S10N(A-H,0-Z) 

COMMON /NUMBRS/ ZRC,ONE,THO,TRES 
COf^ON /TAPENO/ NTAPEl ,NTAPE2 .NTAPE3 

DIMENSION ACKA*l).B(KBfl) »CfKC,I),AMU(KAMU»l) 

FORM CCOFl = CXY 

CALL ZERO(AMUtNE,NE,KAMU» 

FETCH M*HY^SX*S1GZ,SZ*SIGX 

CALL FETCHCNTAPE3, 4,NREC3,A,NJ,NE,KA) 

CALL FETCH (NTAPE3, 23, NREC3fB,NJ,NE,KB) 

CALL FETCH (NTAPE3,14,NREC3,C,NJ,NE,KC) 

CALL ADD3C ONE, A, ONE ,B ,-ONE,C ,NJ ,NE ,KA » 

FETCH HX 

CALL FETCH (NTAPE2, 5 ,NREC?,B ,NJ ,NE ,KB ) 

CALL SATBC ONE,B,A,AMU,NJ,NE,NE,KB,KA,KAMU) 

FETCH M*HX,SZ*STGY,SY*SIGZ 

CALL FETCH (NTAPE3, 1 ,NREC3,A,NJ,NF,KAJ 

CALL PETCH CNTAPE3,19,NREC3,B,NJ,NE,KB) 

CALL FETCH <NTAPE3,24,NREC3,C,NJ,NE,KC) 

CALL ADD3< ONE, A, ONE,B,“ONE,C,NJ,NE,KA » 

FETCH HY 

CALL FETCHCNTAPE2, 6 ,NREC2,B,NJ ,NE ,KB ) 

CALL SATBI-ONE,B,A,AMU,NJ,NE,NE,KR,KA,KAMU) 

CALL WRITE CAMU,NE,WE ,3HCXY,KAMU » 

WRITE(NTAPE1I ( ( AMU( I, J) , Js=l,NE ) , ,NE ) 

FORM CCOF2 = CXZ 

CALL ZERO! AMU,NE,NE,KAMUr 

FETCH HZ 

CALL FETCH CNTAPE2, 7,NREC2,B,NJ,NE,KB ) 

CALL SATB( ONE,B,A,AMU,NJ,NE,NE,KB,KA,KAMU) 

FETCH MTHZ ,SY*SIGX,SXTSIGY 

CALL FETCH INTAPE3, 7,NREC3,A,NJ,NE,KA ) 

CALL FETCH(NTAPE3,13,NREC3,B,NJ,NE,KB) 

CALL FETCH (NTAPE3, 18 ,NREC3,C ,NJ ,NE,KC ) 

CALL ADD3( ONE, A, ONE ,B,»ONE,C,NJ,NE ,KA 1 
FETCH HX 

CALL FETCH (NTAPE2, 5,NREC2,B,NJ,NE,KB) 

CALL SATB(-ONE,B,A,AMU,NJ,NE,NE,KB,KA,KAMU) 

CALL WRITE {AMU,NE,NE,3HCXZ,KAMU> 

WR1TF(NTAPE1 1 ( < AHU( I , J) ,.1=^1 ,NE ) ,1=1 ,NE ) 


-001091 
-001092 
-001093 
001094 
-001095 
001096 
001097 
001098 
001099 
001100 
001101 
001102 
001103 
001104 
001105 
001 106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
001123 
001124 
001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 


■1 


1 


€♦♦♦ 

C*** 

€♦♦♦ 

C*** 

c 

c 

c*** 

c*** 

c*** 

c 

c 

c*** 

c*** 

c 

c 

c*«* 

€♦♦♦ 

c 
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FORM CC0F3 = CYZ 

CALL ZERO{AMU«NF,NEtKAHU) 

FETCH HY 

CALL FETCH (NTAPE2* 6 »NREC2»B»NJ,NEtKB I 
CALL SATB( ONE«B,A«AMU«NJtNE«NE*KR,KA,KAMU} 
FETCH M*HY»SX«IGZtSZ*SIGX 
CALL FETCH (NTAPE3. 4,NREC3«A»NJ«NE»KA) 

CALL FETCH«NTAPE3f23,NREC3*BtNJ,NEtKB) 

CALL FETCH INTAPE3,14,NREC3,C,NJ,NE,KC) 

CALL ADD3( CNFtA* ONEtB«~ONEtCtNJ«NEtKA 1 
FETCH HZ 

CALL FETCH (NTAPE2* 7,NREC2,BtNJ,NE ,KB ) 

CALL SATB|-ONE,B,A,AMU,NJ,NE,NE,KB,KA,KAMUI 

CALL WRITE !AMU,NE.NE»3HCYZ,KAMU» 
WRITE(NTAPEl) ( ( AMU( 1 1 J ) « tNE > f 1=1 *NE I 

FORM CC0F4 = Cll 

CALL ZERC(AMUtNEfNE,KAMU) 

FETCH M*HV AND HY 

CALL FETCH <NTAPE3, 4«NREC39A*NJ»NE»KA) 

CALL FETCH (NTAPE2, 6,NREC2,E,NJ,NEtKBI 
CALL FATBC ONE*RtA»AMO,NJtNE«NE»KBvKA»KAMU) 
FETCH M*HZ AND HZ 

CALL FETCH CNTAPE3, 7 ♦NREC3t A*NJ,NE*KA) 

CALL FETCH(NTAPE2t 7tNREC2tBtNJ,NE,KB) 

CALL SATB( ONE«BtA«AMU»NJ»NEtNEtKB»KA,KAMU} 

CALL WRITE (AMU«NE*NE»3HC11«KAMU) 

WR ITEf NTAP El) ( f AMU( I » J) t J=I »NE ) » 1=1 «NE ) 

FORM CCOF5 = C22 

CALL ZERO(AMUtNEtNEtKAMU) 

CALL SATB( ONE«6tA»AMU»NJtNE«NE»KB*KAfKAMU) 
FETCH M*HX AND HX 

CALL FETCH(NTAPE3, ltNREC3*A*NJ»NE«KA) 

CALL FETCH (NTAPE2t 5tNREC2.B,NJ,NEtKB) 

CALL SATBf ONE*B»A,AMUtNJ»NE,NE»KB»KA»KAMU) 

CALL WRITE CAMU,NEfNE«3HC22*KAMU) 
WRITE(NTAPFl) (f AMU(I,J)«J=l»NE)tI=ltNE) 

FORM CC0F6 = C33 

CALL ZEROf AMUtNEyNEtKAMU) 

CALL SATBf ONE«BtA*AMUtNJtNE»NE »KB*KAtKAMU) 
FETCH M*HY AND HY 

CALL FETCH INTAPE3, A,NREC3t A»NJ*NEtKA) 

CALL FETCH CNTAPE2, 6tNREC2*B»NJ»NETKB) 

CALL SATB( ONE»B>AvAMU»NJ«NE»NEtKBtKA*KAMU) 


001141 
001142 
001143 
001144 
001145 
001146 
001147 
001 148 
001149 
001150 
001151 
001152 
001153 
001154 
001155 
001156 
001157 
001158 
001159 
001160 
001161 
001162 
001163 
001164 
001165 
001166 
001167 
001168 
001169 
001170 
001171 
001172 
001173 
001174 
001175 
001176 
001177 
001178 
001179 
001180 
001181 
001182 
001183 
001184 
001185 
001186 
001187 
001188 
001189 
001190 
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CALL WRITE (AMU*NE,NEt3HC33«KAHUI 001191 

WRITECNTAPEII f ( AMUf I, J) , J=1 ,NE ) , 1=1 ,NE I 001192 

C 001193 

C*** FORM CC0F7 = C12 001194 

CALL ZEROI AMU,ME,NE,KAMU) 001195 

C*** FETCH M*HX 001196 

CALL FETCH(MTAPE3t 1 tNREC3,A,NJtNE,KA» 001197 

CALL SATB( 0ME,B*A»AMU,WJ,NF,NE»K6fKA,KAMU» 001198 

C 001199 

CALL WRITE CAMU,NE,NE,3HC12fKAMU) 001200 

WRITE(NTAPEI) f<AMUCI.J),J=l,NE),I=l,NEI 001201 

C 001202 

C*** FORM CC0F8 = C13 001203 

CALL ZERO( AMU»MEtME«KAMU) 001204 

€♦♦♦ FETCH HZ 001205 

CALL FETCH CNTAPE2, 7,NREC2,B,NJtNE fKB ) 001206 

CALL SATBt nWE,B,A*AMU,NJ,NE*NE,KB,KA,KAMU) 001207 

C 001208 

CALL WRITE CAMU,NE,NE,3HCl3fKAMU» 001209 

WRITE(NTAPEI) ( f AMUf I, J) , J = l,riE 1, 1 = 1 ,NE » 001210 

C 001211 

C«*« form CC0F9 = C23 001212 

CALL ZERO! AMU,NEfNE,KAMU) 001213 

C*** FETCH M*Hv 001214 

CALL FETCH<NTAPE3, 4,NREC3tA,NJ,NIE tKA) 001215 

CALL SATBI OME,B,A,AMU,NJ,NE,NE,KB,KA,KAMU) 001216 

C 001217 

CALL WRITE IAMU,NE,»fE,3HC23,KAMU» 001218 

WRITECMTAPEI) ( f AMU( I« J ) , J=1,NE ) * 1=^1 «NE ) 001219 

C 001220 

RETURN 001221 

END 001222 
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[HOGyP CREE 
t FOR, IS CREE 

COMPILER IXM=lly(EOUIV=CMN) 

SUBROUTINE CREECNREC3tNREC2,NJ,NE,A,B,C yAMUtKAyKeyKCyKAMU) 
IMPLICIT DOUBLE PRECISIONCA-HyO-ZI 
C 

COMMON /NUMBRS/ ZRO,ONE,TWO,TRES 
COMMON /TAPENO/ NTAPEl tNTAPE2»NTAPE3 
C 

DIMENSION AfKA,ll.B*KBfl)fCCKC,l)tAMUfKAMU,I) 

C 

C*.** FETCH M*HX iSZ*SIGY,SY*SIGZ 

CALL FETCH CNTAPE3t 1 *NREC3,A*NJ,NE,KA) 

CALL FETCH (NTAPEBt tNREC3,B»NJ,NE,KB ) 

CALL FETCH CNTAPE3 1 24 ,NREC3 ,C tNJ ,NE yKC ) 

CALL ADD3( ONE»At ONE#B,-ONEtCtNJtNE,KA » 

C*** FETCH HX 

CALL FETCH (NTAPE2t 5,NREC2,B,NJ,NE,KB J 
CALL SATBC ONEfB,A.AMUC7,7) ,NJ,NE,NE,KB *KA,KAMUI 
c*** fetch M*HY,SX*SIGZ*SZ*SIGX 

CALL FETCH(NTAPE3, 4,NREC3,AtNJ*NE,KA) 

CALL FETCH (NTAPE3, 23, NREC3,B,NJ*NE,KB) 

CALL FETCH (NTAPE3,I4,NREC3,C,NJ,NE,KC ) 

CALL ADD3( 0NE,A, ONE,B,-ONE,C,NJ,NE,KAI 
TCH HY 

CALL FETCHCNTAPE2, 6,NREC2,B,NJ,NE,KB» 

CALL SATB( 0N£,B,A,AMUf7,7),NJ,NE,NEtK6,KA,KAMU) 

€*** FETCH M*HZ ,SY*SIGX,SX*S1GY 

CALL FETCH (NTAPE3, 7,NREC3,A,NJ,NE,KAI 
CALL FETCHCNTAPE3,13,NREC3,B,NJ,NE,KBl 
CALL FETCH INTA«>E3, 18 ,NREC3 ,C,NJ ,NE ,K.C I 
CALL A0D3( ONE, A, ONE,B,-ONE,C,NJ,NE,KA ) 

FETCH HZ 

CALL FETCH(NTAPE2, 7,NREC2,B,NJ,NE,KBI 

CALL SATB( 0NE,6,A,AMU(7,7|,NJ,NE,NE,KB,KA,KAMU) 

C*** FETCH JXX*SIGX,JXY*SIGY,JXZ*SIGZ 

CA LL FETCH (NTAPE3, 10 ,NREC3 , A, NJ ,NE ,KA ) 

CALL FETCH (NTAPE3,15,NREC3,B,NJ,NE, KB) 

CALL PETCH(NTA»»E3,20,NREC3,C,NJ,NE,KC) 

CALL A0D3C ONE ,A,-ONE,B,-ONE,C,NJ,NE,KA ) 

C*** FETCH SY*HZ,SZ*HY 

CALL FETCH (NTAPE3, 9,NREC3,6,NJ,NE,KB) 

CALL FETCH (NTAPE3, 6,NREC3,CtNJ,NE,KC) 

CALL AD03I ONE, A, ONE,B,-ONE,C,NJ,NE,KA) 

C*44 FETCH SIGX 

CALL FETCH (NTAPE2, 8,NREC2,B,NJ,NE,KB) 

CALL SAT6( 0NE,B,A,AMU(7,7) ,NJ,NE,NE,KB,KA,KAMU) 
c*** fetch JXY»SIGX,JYY*S1GY,JYZ*SIGZ 

CALL fetch CNTAPE3, 11 ,NREC3,A,NJ,NE,KA) 

CALL FETCH (NTAPE3,16,NREC3,B,NJ,NE,K6) 


-001223 
-001224 
-001225 
001226 
-001227 
001228 
001229 
001230 
001231 
001232 
001233 
001234 
001235 
001236 
001237 
001238 
001 239 
001240 
001241 
001242 
001243 
001244 
001245 
001246 
001 247 
001248 
001 249 
001250 
001251 
001252 
001253 
001254 
001255 
001256 
001257 
001258 
001 259 
001260 
001261 
001262 
001263 
001264 
001265 
001 266 
001267 
001268 
001269 
001270 
001271 
001272 
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CALL 

FETCH tNTAPE3 » 21 tNREC3 1 C t NJ *NE t KC ) 

001273 


CALL 

ADD3(-ONEtA» ONE,Bf~ONE»CrNJtNEtKA) 

001274 


FETCH S2*HX,SX*HZ 

001275 


CALL 

FETCH (NTAPE3 1 3 »NR EC 3 1 B « N J .NE »KB ) 

001276 


CALL 

FETCH f MTAPE3, 8 ,NREC3,C,NJ,NE ,KC ) 

001277 


CALL 

ADD3( ONE*A» ONE«B«-DNEtCtNJtNErKA ) 

001278 

€♦♦♦ 

FETCH SIGY 

001279 


CALL 

FETCH CNTAPEZf 9,NREC2,B,NJ,NE,KB ) 

001 280 


CALL 

SATBf nNEtB*A*AHUI7,7)»NJtNETNE»KB*KA,KAHU1 

001281 

c*** 

FETCH JXZ*SIGX,JYZ*SIG>',JZ7.*SIGZ 

001282 


CALL 

FETCH fNTAPE3.1?tNREC3*A,NJ,NE«KA) 

001283 


CALL 

FETCH f NTAPE3t 17 »NREC3 1 B ,N J ,NE ,KB ) 

001284 


CALL 

FETCH INTAPE3, 22 ,NREC3.C,NJ ,NE ,KC ) 

001285 


CALL 

AOD3C-ONE,A,-ONEtB, ONEtCtNJtNE.KA ) 

001286 


FETCH SX*HY,SY*HX 

001287 


CALL 

F ETCH CNTAPE3 » 5,NREC3*B,NJ,ME,KB» 

001288 


CALL 

FETCH lNTAPE3t 2 tNREC3tC«NJ »NEtKC ) 

001289 


CALL 

ADD3( ONE»A«ONEtB»-GNE,C*Nj*NEtKA) 

001290 


FETCH SIGZ 

001 291 


CALL 

FETCH(NTAPE2flO,NREC2tB,NJ,NE,KB) 

001292 


CALL 

SATBf ONETB»A»AMU(7«7)tNJtNE»NEyKBtKAtKAMU) 

001 293 


CALL 

WRITE (ANUI7t7|yNE ,NE t SHE COEF, KAMI!) 

001294 

C 



001295 


RETURN 

001296 


END 


001297 
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(HDG* 

p 

CREHUO 








-001298 

(FOR, 

IS 

CREMUO 








-001299 


COMPILER (XM=1>, (EQUIV= 

CMN) 






-001300 


SUBROUTINE CREMU0(NREC3 

,NJ,UVEC,A,WS,AMU, 

KA.KWS, 

KAMU) 

001301 


IM»»LIC1T DOUBLE PRECISION(A“H 

,0-Z) 





-001302 

C 










001303 


COMMON /NUMBRS/ ZRO 

.ONE 

.TWO.TRES 





001304 


COMMON /TAPENO/ NTAPEl, 

NTAPE2 

.NTAPE3 





001305 

C 










001306 


DIMENSION A(KA,I ),WS(KWS,n,AHU(KAMU,n ,UVEC(1) 


001307 

C 










001308 


FETCH M*RHOX,M*RHOY 

.M*RHOZ 






001309 


CALL 

FETCH (NTAPE3, 25 ,NREC3,A( 1,1) ,NJ,1 

,KA) 



001310 


CALL 

FETCH(NTAPE3,?6,NREC3,A(1,2I,NJ,1 

,KA) 



001311 


CALL 

FETCH (NTAPE3,27,NREC3,A(1,3I ,NJ,1 

,KA) 



001312 

c*** 

FORM 

JXXO 








001313 


CALL 

SATB( ONE,WS(l 

.13) 

, Ad, 

3),AMUd 

,1) 

,N J, 

1, 

ItKWS, KA.KAMU) 

001314 


CALL 

SATB( ONE,WS(l 

,12) 

, Ad, 

2),AHUd 

,1) 

,NJ, 

1, 

ItKWS, KA.KAMU) 

001315 


CALL 

SATB( TWO.WSIl 

,13) 

,WSd, 

lQ),AMUd 

• 1) 

,NJ, 

1, 

l.KWS.KWS.KAMU) 

001316 


CALL 

SATB( TWO.WSd 

,12) 

,wsd. 

9),AMUd 

,1) 

,NJ, 

1, 

1,KWS,KWS,KAMU) 

001317 


CALL 

SATB( ONE.UVEC 


,WSd, 

2),AMUd 

,1) 

,NJ, 

It 

l.KWS.KWS.KAMU) 

001318 

€♦♦♦ 

FORM 

JXYO 








001319 


CALL 

SATB(-ONE,WS(l 

,12) 

, Ad, 

D.AMUd 

,2) 

,NJ, 

It 

l.KWS, KA.KAMU) 

001320 


CALL 

SATB(-ONE,WS(l 

,12) 

,WSd, 

8),AMUd 

,2) 

♦NJ, 

It 

l.KWS.KWS.KAMU) 

001321 


CALL 

SATB(-ONE,HS(l 

til) 

,WS(1, 

9),AMU(1 

• 2) 

•NJ, 

It 

l.KWS.KWS.KAMU) 

001322 


CALL 

SATB(-ONE,UVEC 


,WSd, 

5),AMUd 

• 2) 

•NJ, 

It 

l.KWS.KWS.KAMU) 

001323 

c*** 

FORM 

JXZO 








001324 


CALL 

SATB(-ONE,WS(l 

,13) 

• Ad, 

D.AMUd 

,3) 

,NJ, 

1, 

l.KWS, KA.KAMU) 

001325 


CALL 

SATB(-ONE,WS(l 

,13) 

,WS(1, 

8),AMUd 

• 3) 

• NJ, 

It 

l.KWS.KWS.KAMU) 

001326 


CALL 

SATB(-ONE,WS(l 

,11) 

,WSd, 

10),AMUd 

• 3) 

tHJt 

It 

l.KWS.KWS.KAMU) 

001327 


CALL 

SATB(-ONE,UVEC 


,WSd, 

6),AMUd 

• 3) 

♦NJ^ 

It 

l.KWS.KWS.KAMU) 

001328 

c*** 

FORM 

JYYO 








001329 


CALL 

SATBT ONE,HS(l 

♦ 13) 

♦ A(l, 

3),AMU(2 

• 2) 

•NJ^ 

It 

l.KWS, KA.KAMU) 

001330 


CALL 

SATB( ONE,WS(l 

♦ 11) 

♦ Ad, 

1),AMU(2 

,2) 

•NJ^ 

It 

l.KWS, KA.KAMU) 

001331 


CALL 

SATB( TWO,WS(l 

♦ 13) 

♦WSd, 

10),AMU(2 

♦ 2) 

tHJ9 

It 

l.KWS.KWS.KAMU) 

001332 


CALL 

SATB( TWOfWSd 

♦ 11) 

,wsn. 

8),AMU(2 

• ?) 


It 

l.KWS.KWS.KAMU) 

001333 


CALL 

SATB( ONE,UVEC 


♦WSd, 

3), AMU (2 

• 2) 

•NJ, 

It 

l.KWS.KWS.KAMU) 

001334 

C*** 

FORM 

JYZO 








001335 


CALL 

SATB(-ONE,WSd 

,13) 

, Ad, 

2),AMU(2 

• 3) 

,NJ, 

It 

l.KWS. KA.KAMU) 

001336 


CALL 

SATB(-ONE,WSd 

,13) 

,WSd, 

9»,AMUC2 

• 3) 

• NJ, 

It 

l.KWS.KWS.KAMU) 

001337 


CALL 

SATB(-ONE,WSd 

,12) 

,WS(), 

!0),AMU(2 

• 3) 

•NJ, 

It 

l.KWS.KWS.KAMU) 

001338 


CALL 

SATB(-ONE,UVEC 


,WSd, 

7),AMl»f2 

,3) 

♦NJ, 

It 

l.KWS.KWS.KAMU) 

001339 

c*** 

FORM 

JZZO 








001340 


CALL 

SATB( ONEtWSd 

,12) 

t Ad, 

2),AHU(3 

,3) 

♦ NJ, 

It 

l.KWS, KA.KAMU) 

001341 


CALL 

SATB( ONE.WSd 

,11) 

♦ A(l, 

1),AMU(3 

,3) 

•NJ, 

It 

l.KWS. KA.KAMU) 

001342 


CALL 

SATB( TWO.WSd 

,12) 

•WSd, 

9),AMU(3 

• 3) 

,NJ, 

It 

l.KWS.KWS.KAMU) 

001343 


CALL 

SATB( TWO.WSd 

,11) 

• WSd, 

8),AMU(3 

♦ 3) 

♦ NJ, 

It 

l.KWS.KWS.KAMU) 

001344 


CALL 

SATB( ONE.UVEC 


,WS(1, 

A),AMU(3 

• 3) 

,NJ, 

It 

l.KWS.KWS.KAMU) 

001345 

c*** 

FORM 

SXO 








001346 


CALL 

SATB( ONE.UVEC 


,WS ( 1 , 

8),AMIJ(3 

• 5) 

♦ NJ, 

It 

l.KWS.KWS.KAMU) 

001347 



1 


1 
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37 


CALL SATBf ONEtHS(ltll)«WSClt l)*AMUf 3«5)*NJ» 1» 1«KWS,KHS*KAMU1 001348 

C*** FORM SYO 001349 

CALL SATBf ONEtUVEC tWSfl* 9)tAMUIl«6l *NJ« 1* 1 tKWStKWS vKANUI 001350 

CALL SATBf ONE.WSf l«12},WSf 1» 11 »AMUf 1»6J «NJ, 1, l»KWStKWS.KAMUI 001351 

C*** FORM SZO 001352 

CALL SATBf ONE«UVEC .WSfl,10)*AMUf 2*^1 *NJ« 1» 1«KWS»KWS»KAMU} 001353 

CALL SATBf ONE»WSf l»13)«WSf !• 1 1 *AMUf ?«4) tNJ* 1» ItKWStKWSvKAMUl 001354 

AMUf2»6) = -AMUf3,5) 001355 

AMUf3»4) -AMUfl*6 ) 001356 

AMUfl»5) = -AMUf2*4» 001357 

C*** FORM MASS 001358 

CALL SATBf OME.UVEC tWSfl* l)»AM0f4,4)»NJ» 1, 1 ,KWS»KWS »KAMU) 001359 

AMUf5t5) = AMUf4v4) 001360 

AMUf6t6) s AMUf4t4) 001361 

C 001362 

CALL WRITE fAMUfltl)*3t3t5HINERO»KAMU) 001363 

CALL WRITEfAMUflt4)*3t3t5HSTAT0tKAMU) 001364 

CALL WRITEfAMUf4,4!,3,3.5HMASS0»KAMU) 001365 

C 001366 

RETURN 001367 

END 001368 


/> 
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[HDG»P CRET3 
tFOR,IS CRET3 

COMPILER (XM=n, (EQUIV=CMNI 

SUBROUTINE CRET3 (NREC2fNJ,NE* AtB,WS,KA*KB,KWS) 
IMPLICIT DOUBLE PRECISION I A-H,0-Z I 
C 

COMMON /Nl'MBRS/ ZRO,ONE»TWO,TRES 
COMMON /TAPENO/ NTAPEl ,NTAPE2 tNTAPE3 
C 

DIMENSION A(KA,1) »B(KB»1) •WS(KMStl) 

C 

C*** FETCH M 

CALL FETCH(NTAPE2, 1 *NREC2»WS ( It DtNJtltKWS) 
C**» FETCH JXXf.-.tJYZ 

CALL FETCHCNTAPF2, 2 ,NREC2,WS I 1, 2)tNJ»6»KWS) 
C*** FETCH SXtSYtSZ 

CALL FETCH (NTAPE2t 3,NREC2*WS ( 1, 8)tNJt3tKWS) 
C*** FETCH GEOMETRY 

CALL FETCH (NTAPE2t 4,NREC2,WS I 1 t 11 ) tNJ, 3tKWS I 
C*** FETCH HX 

CALL FETCH (NTAPE2, 5fNREC2tAtNJtNE«KA) 

CALL STORE (NTAPE3tWS (It 1 UAtBtNJtNEtKWStKAtKB ) 
CALL STORE (NTAPE3tWS(lt 9 1 1 AtB tNJ tNE tKWStKAtKB ) 
CALL STORE (NTAPE3 tWS ( 1 1 10 1 tAtB tNJ tNE tKWStKAtKB ) 
C*** FETCH HY 

CALL FETCH (NTAPE2t 6tNREC2tAtNJtNEtKA) 

CALL STORE (NTAPE3tWS (It 1 >t AtBtNJtNEtKWStKAtKB ) 
CALL STORE (NTAPEStWS (It 81 tAtBtNJtNE tKWStKAtKB ) 
CALL STORE (NTAOE3tWS(ltlO)tAtBtNJ tNE tKWStKAtKB) 
C*** FETCH HZ 

CALL FETCH (NTAPE2t 7 tNREC2.AtNJtNEtKAI 
CALL STORE (NTAPE3tWS( It 1 ) t AtBtNJtNEtKWStKAtKB ) 
CALL STORE (NTAPE3tWS (It 8 ) »AtBtNJtNE tKWStKAtKB ) 
CALL STORE (NTAPE3tWS(lt 9) tAt6»NJtNEtKWStKAtKB) 
C*** FETCH SIGX 

CALL FFTCH(NTAPE2t 8 tNREC2t AtNJ,NEtKA» 

CALL STORE (NTAPE3tWS( It 2)t AtBtNJtNEtKWStKAtKB) 
CALL STORE (NTAPE3tWS(lt 5 ) t AtBtNJtNEtKWStKAtKB ) 
CALL ST0RE(NTAPE3tWS(l, 6),AtBtNJtNEtKWStKAtK6 ) 
CALL STORE (NTAPE3tWS(lt 9) t AtBtNJ tNEtKWStKAtKB ) 
CALL STORE (NTAPE3tWS (It 10) tAtB tNJ tNE tKWStKAtKB) 
C*** FETCH SI GY 

CALL FETCH (NTAPE2t 9,NREC2t AtNJtNEtKA) 

CALL STORE (NTAPE3tWS (It 5 ) tAtBtNJtNE tKWStKAtKB ) 
CALL STORE (NTAi*E3tWS(lt 3 ) tAtB tNJ tNEtKWStKAtKB ) 
CALL STORE (NTAPE3tWS (It 7>t AtBtNJtNEtKWStKAtKB ) 
CALL ST0RE(NTAPE3tWS(lt 8 ) tAtBtNJtNEtKWStKAtKB ) 
CALL STORE (NTAPE3tWS(ltlO)tAtBtNJtNEtKWStKAtKB) 
C*** FETCH SIGZ 

CALL FETCH (NTAPE2tlOtNREC2tAtNJtNEtKA) 


-001369 
-001370 
-001371 
001372 
-001373 
001374 
001375 
001 376 
001377 
001378 
001379 
001380 
001381 
001382 
001383 
001384 
001385 
001386 
001387 
001388 
001389 
001390 
001391 
001392 
001393 
001394 
001395 
001396 
001397 
001398 
001399 
001400 
001401 
001402 
001403 
001404 
001405 
001406 
001407 
001408 
001409 
001410 
001411 
001412 
001413 
001414 
001415 
001416 
001417 
001418 


CALL STORE tNTAPE3tWS(l» 6)«AtBtNJtNEtKWS«KAtKB) 001419 

CALL STORE (NTAPE3,WS (It 7>tAtB»NJtNEtKWStKAtKB) 001420 

CALL STORE CMTAPE3fWS lit 4»tAtBtMJtMEtKWStKAtKB) 001421 

CALL STORE INTAPE3tWS (It 8 ) #AtB,WJtWEtKWStKAtKB I 001422 

CALL STORE (NTAPE3tHS(l, 9) t AtBtNJtNE tKWS.KAtKB) 001423 

CALL STORE (MTAPE3tWS( It 1 ) tWS ( It 11) tBtN Jt ltKHStKWS«KB ) 001424 

CALL STORE (NTAPE3tWS (It DtVfS(ltl2)tBtN JtltKWStKWStKB) 001425 

CALL STORE (NTAPE3tWS (It 1 )tWS (ltl3)t6tNJtltKWStKWStKB) 001426 

001427 

RETURN 001428 

END 001429 


noon 


j i . j I I I 
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fHOG.P OCMPLX -001430 

tFOR.IS OCMPLX -001431 

COMPILER CXM=1I, CEQUIV=CMNI -001432 

COMPLEX RINCTION OCMPLX CX,Y) -001433 

-001434 

OOUBLE PRECISION ARGUMENTS XtY ARE COMBINEO TO FORM A -001435 

SINGLE PRECISION COMPLEX NUMBER RETURNED AS OCMPLX -001436 

-001437 

IMPLICIT DOUBLE PRECISION (A-H,0-Zl -001438 

C -001439 

OCMPLX = CMPLXISNGL(X)«SNGLIY)) -001440 

RETURN -001441 

END -001442 



] 
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fHDGtP OCOM2 -001443 

(FOR»IS OCOM2 -001444 

COMPILER (XN=l}t(EOUIV=CMN) -001445 

SUBROUTINE 0C0M2 fUtDtNtKR) 001446 

IMPLICIT DOUBLE PREC ISIPN ( A-H ,0-Z ) -001447 

DIMENSION UfKR«I)*D(l) 001448 

DATA EPStNOT /1 .0-15 1 6/ 001449 

C 001450 

IF IN .EO. 1» 60 TO 20 001451 

NMl = N - 1 001452 

DO 15 L=1*NM1 001453 

IF (OABSIUILtLI) .LT. EPSI GO TO 998 001454 

LPl = L ♦ 1 001455 

DILI = UIL*LI 001456 

00 15 1=LP1,N 001457 

S = UlLfl) AIILtLI 001458 

DO 10 J=I*N 001459 

lO Ufl.JI = Ull.JI - S4UIL.J) 001460 

15 UCLfll = S 001461 

20 0(N» = UIN,N) 001462 

RETURN 001463 

C 001464 

998 WRITE INOT.lOOn 001465 

1001 FORMAT flHl*40HMATRIX SINGULAR* DC0M2* PROGRAM STOPPED.! 001466 

STOP 001467 

end 001468 



ooonoooooononnnnonnonono 


[HDG,P DCQRRT 
[FOR, IS DCORRT 

COMPILER f XM=1), (EOUIV=CMN) 

SUBROUTINE DCQRRT (RR,RT,M,KR ,KC,KZ,RLRT,CMPR I 
IMPLICIT DOUBLE PRECISION! A-«, 0-2 ) 

SUBROUTINE RECEIVES OR ROOT OUTPUT OF THE FORM, 

RR(I) ,Rim,I==l,N 

AND PLACES REAL ROOTS (INCLUDING ZEROS) INTO 
MATRIX RLRT (SIZE KR), THEN PLACES THE 
COMPLEX PAIRS (A(I) +J BCD) INTO 
MATRIX CMPR — COMPLEX PAIR ORDER IS 

CHPRdl = A(I) 
CMPR(I+II = B(I) 

SAVES ONLY REAL AND POSITIVE IMAG PARTS IN CMPR. 

SIZE OF CMPR IS 2 ♦ KC. 

SUBROUTINE ARGUMENT DESCRIPTIONS 

RR = INPUT ARRAY OF REAL PARTS. SIZE IS N 

RI = INPUT ARRAY QP IMAGINARY PARTS. SIZE IS N. 

N = INPUT SIZE OF RR AND RI. NUMBER OF QR ROOTS. 

KR = OUTPUT SIZE OF RLRT. NUMBER OF REAL R00T2, 

(INCLUDING ZEROS). 

KC = NUMBER OF COMPLEX PAIRS. 

KZ = OUTPUT NUMBER OF ZEROS. 

RLRT = OUTPUT REAL ROOT ARRAY. SIZE KR. 

CMPR = OUTPUT COMPLEX PAIR ARRAY. SIZE 2*KC. 

DIMENSION RR (1 ),RI (1 ) ,RLRT( 1) ,CMPR ( 1 ) 

KR = 0 
KC = 0 
KZ = 0 

DO 10 1=1, N 

IF (Rim .EQ. O.DO) GO TO 5 
IF (RKI) .LT. O.DO) GO TO 10 
KC = KC+1 
L = 2*KC 
CMPR(L-l) = RR(I) 

CMPR(L ) = RKI) 

GO TO 10 
5 CONTINUE 

KR = KR+1 
RLRT(KR) = RR(I) 

IF (RR(I) .EQ. O.DO) KZ = KZ+1 
10 CONTINUE 

RETURN 
END 


-001469 
-001470 
-001471 
001472 
-001473 
001474 
001475 
001476 
001477 
001 47B 
001479 
001480 
001481 
001482 
001483 
001484 
001485 
001486 
001487 
001488 
001489 
001490 
001491 
001492 
001493 
001494 
001495 
001496 
001497 
001498 
001499 
001 500 
001501 
001 502 
001503 
001504 
001505 
001506 
001507 
001508 
001509 
001510 
001511 
001512 
001513 
001514 
001515 
001516 
001517 
001518 


I 


43 

fHDG*P OFORMB -001519 

f FOP.* IS OFORMB -001520 

COMPILER (XH-l)*fEOUIV-CMN) -001521 

SUBROUTINE DFORMB<KR ,KC,RLRT,CMPR,FBR,FBC*SCMPR.SF,ACCO*GB) 001522 

IMPLICIT DOUBLE PRECISION U-H,0-Z I -001523 

CDFORMB FACTORED FORM TIME CONSTANTS* DAMPING AND FRFOUENCY 001524 

DIMENSION RLRT(l).CMPRm*FBRm*FBCm *SCMPRm 001525 

DIMENSION GB(2» 001526 

GBn)=ACCD 001527 

LZ=0 001528 

SCI»1.D0/SF 001529 

IF(KRI140* 140* 100 001530 

100 DO 130 L=1*KR 001531 

IF(RLRT(LI »120* 110* 120 001532 

110 FBRfL)=0-00 001533 

LZ=LZ+1 001534 

GO TO 130 001535 

120 FBRfL)=-1.00/(RLRTCL»*SCII 001536 

GB(ll=-GBni+RLRT(LI 001537 

130 CONTINUE 001538 

140 1F(KC)170* 170* 150 001539 

150 KK=2*KC 001540 

DO 160 L=2,KK*2 001541 

GB m=GB(l )*ICMPRCL-1»**2+CMPR(L>**2) 001542 

SCMPRIL-1I=CMPR(L-1»*SCI 001543 

FeC«U=0SQPTISCMPRIL-ll**2+fCMPPIL)*SCI)**2» 001544 

160 FBC(L-1I= -SCMPRIL-n/FBC(L» 001545 

170 G6(2)sGB(l) 001546 

IF (LZ .EQ. 0) GO TO 180 001547 

GBI2)=GBf2 )»SF**LZ 001548 

180 RETURN 001549 

end 001550 


^ I 1 I I 1 J 1 
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rHDG.P DIMAG -001551 

IFOR » IS DIMAG -001552 

COMPILER f XM=l»tfE<JUIVsCMNI -001553 

DOUBLE PRECISION FUNCTION DIMAG (Y» -001554 

COMPLEX Y 001555 

COMPLEX SY 001556 

SY = Y 001557 

DIMAG = DBLE (AIMAG(SY)) 001558 

RETURN 001559 

END 001560 


i 1 1 1 I 1 ^ 
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fHDG.P OREAL -001561 

tFORfIS DREAL -001562 

COMPILER (XM^lls (EQUIV=CMN) -001563 

DOUBLE PRECISION FUNCTION DREAL (Y» -001564 

COMPLEX y 001565 

COMPLEX SY 001566 

SY = Y 001567 

DREAL = OBLE (REALISY)) 001568 

RETURN 001569 

END 001570 


o o n n o n o o o n n o n n o o n n n 


1 


FHOG 

tFOR 


A6 


»p 

OYNSAA 

-001571 

.IS 

DYNSAA 

-001 572 

COMPILER (XH=1),CEQUIV=CMN) 

-001573 

SUBROUTINE OYNSAA 

-001574 

IMPLICIT DOUBLE PRECISION(A-H,0-Z» 

-001575 



001576 



001 577 


COMMON /CONPAR/ 

001570 

♦ 

CNTOTA(IOO) 

9501579 


COMMON /GGOATA/ 

001580 

♦ 

GAMGI (3 ) .GMAG.RCMAG 

001581 


COMMON /ILINER/ 

001582 

♦ 

IFLNER 

001583 


COMMON /MAXMUM/ 

001584 


NBMAX ,MMMAX.NSPMAX,NMWMAX.NMWBOD.NMDBOD.KMU,KY,KU 

001585 


COMMON /MISCNO/ 

001586 

♦ 

NOP RNT, NOPLOT 

001587 


COMMON /NHNS / 

001588 

♦ 

NHPOK 5), NSPOK 5) 

1201589 


COMMON /SPECIF/ 

001590 

♦ 

BETAHI6, 5),PETAHD(6. 5) .AM0(2. 5 ) .RH (3 ,3 ,24 ) ,RS (3,3 , 20 ) , 

1601591 

* 

DH(3,28),DS(3,20),IM0(3, B),NM0W(5, 5) .IFTSMWdO) , 

1701592 

4t 

NB,NH,NSPT,NOFMO,NDELTA,ITOPOL(2, 5),IRGFLX( 5),IHDATA(7, 

5), 1801593 

* 

LOCU( 12), LENU (12) ,NU ,NBETA ,NLAM ,NEO 

1901594 


COMMON /SUMMRY/ 

001595 


ASUMRYI 10,6 ) , ISUMRYI 10,3 ) .KSUMRY 

9801596 


COMMON /TAPENO/ 

001597 


NTAPE 1.NTAPE2 ,NTAPE3 

001598 


COMMON /TIMESS/ 

001599 

♦ 

startt,oeltat,t,enot,tmst 

001600 



001601 

DIMENSION WV(5).TMDATA(3),IPDATA(3) 

001602 

EQUIVALENCE (GAMGI ( 1 ) .WVd )) 

001603 



001604 



001605 

m 

= NO. OF BODIES 

001606 

NH 

= NO. OF HINGES (.GE. NB) 

001607 

IRGFLXai = (0 IF L IS RIGID). (MIL) IF L IS FLEXIBLE) 

001608 


MIL) = NO. OF MODES OF BODY (L) 

001609 


L=1,NB 

001610 

NMCW(L) NO. MOMENTUM WHEELS/BODVf L ) , L = 1»NB 

001611 

ITOPOLH.D = 1 (BODY 1) 

001612 

ITOPOLI2.1) = 0 (INERTIAL REFERENCE) 

001613 

ITOPOL(l.K) = LI, (K .GT. 1) 

001614 

ITOPOL(2.K) = L2, (K .GT. 1) 

001615 


BODY(Ll) REL. TO B0DY(L2). K=l.NH. 

001616 

IHDATA(l.K) = ITYPE (EULER PERMUTATION 1.2... 12). K=1.NH 

001617 


(J.K) = 0 IFORCEO/FREE) 

001618 


(J.K) = 1 (FIXED CONSTRAINT) 

001619 


(J.K) = 2 (RHEONOMIC CONSTRAINT), — J=2,7. K=1 ,NH 

001620 


1 
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C BETAH(J,K) = INITIAL HINGE COORDINATES# (J=l«6# K=1#NH» 

C BETAHOfJ.K) = INITIAL HINGE RATES, (J=l,6, K=I,NH» 

C AMfL) = MASS OF BODYCL), L=1,NB 
C SWOMdtLI = STATIC MOMENT OF BODY(L), L = 1,NB 

C AIN(I,L) = MOMENT OF INERTIA PROPERTIES OF BODY(L), 1=1,6, L=1,NB 

C 

C 


1001 FORMAT (1615) 

2001 FORMAT (//I.5X48HSUMMARY OF OYNAMIC-SIMULATION-PROGRAM INPUT DATA, 
* 10(2H ♦) ,//3X12HACTUAL S1ZES5X13HMAX1MUM SIZES4X12HINTEGRAT10N 

4HDATA 12X21HGPAV1TY GRADIENT DA TA 17X1 OHM ISC . DATA, 

/3X13flH-) , 4X13 ( 1H-), 4X18 nH-|,5X37(lH-), 6X11 (1H-), 

/3X9HNB = IA#4X9HNBMAX = I4,A.X9HSTARTT = 1 PD10.3,4X7HG1 

1PD10.3,4X8HGAMA1 = 1PD10.3,4X9HN0PRNT = 12, 

/3X9HNH = T4,4X9HNHMAX = I4,4X9HDELTAT = 

1PD10.3,«X8HGAMA2 = IPDIO .3 ,4X9HN0PL0T =12, 

/3X9HNSPT = I4,4X9HNSPMAX = 14,4X9HEN0T 
1PD10.3,4X8HGAMA3 = IPDIO.3 ,4X9HIFLNER = 12, 

/3X9HN0FM0 = I4,4X9HNMWMAX = 14, 

1PD10.3,A^X8HRCMAG = 1PD10.3, 


* 

* 

* 

* 

♦ 

* 

* 

* 

* 

« 

* 

* 

* 

* 

* 


1PD10.3,4X7HG2 


= 1PD10.3#4X7HG3 


27X7HGMAG = 


/3X9HNDELTA 

/3X9MNU 

/3X9HNBETA 

/3X9HNLAM 

/3X9HNE0 


14 ,4X9HNMWB00 = 14, 
I4#4X9HNHDB0D = 14, 
I4,4X9HKMU = 14, 
I4,4X9HKY = 14, 
I4,4X9HKU = 14) 


2002 FORMAT (//1X49HTHE TOPOLOGY ARRAY (ITOPOL) FOR THIS CASE FOLLOWS) 

2003 FORMAT (//1X50HTHE CONSTRAINT SPECIFICATIONS FOR THIS CASE FOLLOW) 


2004 FORMAT (//1X39HTHE SPECIFIED INITIAL HINGE ANGLES AND 

♦ 28HD IS PLACEMENTS (BETAH) FOLLOW) 

2005 FORMAT (//1X49HTHE SPECIFIED INITIAL HINGE RATES (BETAHD) FOLLOW) 

2006 FORMAT (//1X45HTHE NO. OF ELASTIC MOOES /BODY ARRAY (IRGFLX) 

♦ 7HF01L0WS) 

2007 FORMAT (//1X47HTHE NO. OF R/Q HINGE POINTS/BODY ARRAY (NHPOI ) 

♦ 7MF0LL0WS) 

2008 FORMAT (//1X44HTHE NO. OF SENSOR POINTS/BODY ARRAY (NSPOI) 

♦ 7HF0LL0WS) 

2009 FORMAT (//1X40HTHE MOM. WHEEL/BODY TABLE (NMOW) FOLLOWS ) 

2010 FORMAT (//1X44HTHE STATE VECTOR LENGTH ARRAY (LENU) FOLLOWS ) 

2011 FORMAT (//1X46HTHE STATE VECTOR LOCATION ARRAY (LOCU) FOLLOWS) 

2012 FORMAT (//1X50HTHE SPECIFIED SENSOR POINT/BODY CORRELATION ARRAY 

♦ 16HIIFTSMW) FOLLOWS ) 

2013 format (//1X43HTHF FOLLOWING DATA IS SPECIFIED MOM. WHEEL 

♦ 47H INFORM AT ION (IF ANY) AND CONTROLLER INFORMATION /1X90(1H-)) 

2014 FORMAT (//1X45HTHE SPECIFIED MOM. WHEEL CONTROL ARRAY (IMO) 

♦ 7HFOLLOWS5 

2015 FORMAT (//1X50HTHE SPECIFIED MOM. WHEEL RATES AND INERTIAS (AMO) 

♦ 7HF0LL0W ) 

2016 FORMAT (//1X,48HTHE SPECIFIED CONTROLLER INITIAL CONDITIONS AND 

♦ 22HCHARACTERISTICS FOLLOW /3X30H(THE FIRST NDELTA ARE INITIAL 

♦ 38HCONTROLLER STATE VARIABLES, THERE ARE I3,12H ADDTTIONAl 


001621 
001622 
001623 
001624 
001625 
001626 
001627 
001628 
001629 
001630 
001631 
001632 
001633 
001634 
001635 
001636 
001637 
001638 
001639 
001640 
001641 
001642 
001643 
001644 
001645 
001646 
001647 
001648 
001649 
001650 
001651 
001652 
001653 
001654 
001655 
001656 
001657 
001658 
001659 
001660 
001661 
001662 
001663 
001664 
001665 
001666 
001 667 
001668 
001669 
001670 
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♦ 19HC0NTR0L PARAMETERS)) 

2110 FORMAT IlHl, 28HINPUT DATA ERRORt NERROR = 13) 

C 

DATA NIT,NOT / 5, 6/ 

C 

CCCCC 

KCONT = 100 
KSOMRY s 10 

CCCCC 

READ (NIT* 1001) NB *NH»NSPT»NOFMO,NDELTA 


CALL READIM ( IT0P0L*N1 ,N2 *2 «NHHAX ) 

IF (N1.NF.2 .OR. N2.NE.NH .OR. NH.LT.NB) GO TO 099 

NERROR 

CALL READIM (IRGFLX*NltN2«l*NBMAX) 

IF (M2 ,NE. NB) GO TO 999 

NERROR 

CALL READIM ( IFTSMW,N1»N2*1 *NSPMAX) 

IF (N2 .NE. NSPT) GO TO 999 

NERROR 

CALL READIM ( IHDATA*Nl«N2t 7*NHMAX) 

IF (NI.NE.7 .OR. N2.NE.NH) GO TO 999 

NERROR 

CALL READ ( BETAH,N1 *N2* 6*NHMAX) 

IF (N1.NE.6 .OR. N2.NE.NH) GO TO 999 

NERROR 

CALL READ ( BETAHD *N1 »N2* 6*NHMAX) 

IF (N1.NE.6 .OR. N2.NE.NH) GO TO 999 

NERROR 

IF (ITOPOL(l*l).NE.l .OR. IT0P0L(2«I l.NE.O) GO TO 999 

NERROP 

DO 605 J=2*NH 

IF CITOPOLd.J) .EO. IT0P0L(2,J)) GO TO 999 
605 CONTINUE 
C 

CCC PRELIMINARY TOPOLOGY CHECK, COMPLETE CHECK DONE BY ROTDH .... 

NERROR 

DO 610 N=1 ,NB 
DO 615 Id, 2 
DO 615 J=2,NH 

IF (ITOPOLII,J) .EQ. N) GO TO 610 
615 CONTINUE 
GO TO 999 
610 CONTINUE 

NERROR 

DO 620 J=1,NB 

IF (IRGFLX(J).LT.O .OR. IRGFLX ( J) .GT.NMDBOD ) GO TO 999 
620 CONTINUE 

NERROR 


001671 

001672 

001673 

001674 

001675 

001676 

9601677 

9901678 

001679 

001680 

001681 

1 001682 
001683 
001684 

2 001685 
001686 
001687 

3 001688 
001689 
001690 

4 001691 
001692 
001693 

5 001694 
001695 
001696 

6 001697 
001698 
001699 

7 001700 
001701 

8 001702 
001703 
001704 
001705 
001706 
001707 

9 001708 
001709 
001710 
001711 
001712 
001713 
001714 
001715 

10 001716 
001717 
001718 
001719 

11 001720 


I 


1 


1 
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DO 625 Jsl.NSPT 

IF (IFTSMW (JI.LT.l .OR. IFTSMWt J) .6T.NB ) 60 TO 999 
625 CONTINUE 

NERROR = 12 

DO 630 J=l,NH 

IF (IHDATAfI »J).LT.l .OR. IHDATAdtJ) •GT.12) GO TO 999 
00 630 1=2,7 

IF f THDATA(I,J).LT.O .OR. IHDATAI I ,Jl .GT.2) GO TO 999 
630 CONTINUE 

DO 5 N=1,NB 
NHPOKNI = 0 
NSPOI(N) = 0 
DO 10 1=1,2 
00 10 J=2,NH 

IF CITOPOLII,JI .EQ. N» NHPOKNI = NHPOKNI ♦ 1 
10 CONTINUE 

OO 15 J=1,NSPT 

IF fIFTSMWfJI .EQ. Nl NSPOIfNI = NSPOKNI ♦ 1 
15 CONTINUE 
5 CONTINUE 

II = NMWBOO + 2 
00 40 1=1,11 
DO 40 J=1,NBMAX 
40 NMOW{I,JI = 0 

IF fNOFMO .EQ. 01 GO TO 41 

NERROR = 13 

CALL READIH nH0,Nl,N2, 3,NMMMAXI 
IF fNl.NE.? .OR, N2.NE.NCFM0I GO TO 999 

NERROR = 14 

CALL READ (AH0,N1,N2, 2,NMWHAXI 
IF CN1.NE.2 .OR. N2.NE.N0FM0I GO TO 999 

NERROR = 15 

00 635 J=I ,NOFMO 

IF lIMOd, JI .LT.l .OR. IMOd,JI.GT.NSPTI GO TO 999 
IF IIM0(2, JI.LT.l .OR. IHOf 2, JI .GT.3I GO TO «»99 
IF CIM0C3, JI.LT.0 .OP, 1H0I3, JI.6T.T > GO TO 999 
IF fAM0(2,JI .LE. 0.0 0| GO TO 999 
635 CONTINUE 

NERROR = 16 

IF (NOFMO .EO. II GO TO 641 

Nl = NOFMO - 1 

00 640 1=1 ,N1 

IPl = I ♦ 1 

DO 640 J=I PI, NOFMO 

IF dMOd,II .EQ. IMOd,JII 60 TO 999 

640 CONTINUE 

NERROR =17 

641 DO 45 N=l, NOFMO 
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001740 
001741 
001742 
001743 
001744 
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NI>TS = IMOflvN) 

001771 



NBOO » IFTSMWCMPTSI 

001772 



NMOWfl,NBOO) s NMOW(ltNBOD) + 1 

001773 



IF lIHOOtNI *NE. 0) NM0W(2»NB0D) = NM0W(2»NB0D) * 1 

001774 



IC s NNOWdtNBOO) * 2 

001775 



IF CIC .GT. in GO TO 999 

001776 


45 

MMOM(TC,NBOO) = N 

001777 


41 

CONTINUE 

001778 

c 



001779 



NEC = 0 

001780 



DO 50 N=1»NB 

001781 



NFO = NEO ♦ IRGFLXIN) 

001782 


50 

LENU(N) = 6 ♦ IPGFLXJN) ♦ NM0W(2»N) 

001783 



LOCU(l) = 1 

001784 



DO 55 N=2,NB 

001785 


55 

LOCUfNl = lOCUCN - 1) + LENUIN - IJ 

001786 



NU = LOCUfNB) ♦ LENtl(NB) - 1 

001787 



DO 56 N==1*NB 

001788 


56 

LENIMN^NB) = IRGFLX(N) 

001789 



DO 57 N^l.NB 

001790 



NMl s N “ 1 

001791 


57 

LOCU(N+NB) = LOCUINNl-i^NB) ♦ LENUINMl^NB) 

001792 



NBETA = 0 

001793 



NLAM = 0 

001794 



DO 60 I=2»7 

001795 



DO 60 Jsl.NH 

001796 



IF (IHDATAfTvJ) -NE. 11 NBETA = NBETA ♦ 1 

001797 



IF CIHDATAfItJ) .NE. 01 NLAM = NLAM ♦ 1 

001798 


60 

CONTINUE 

001799 



NEQ = NEQ ♦ NBETA ♦ NOELTA ♦ NU 

001800 



LENU(2*NB^n = NBETA 

001801 



LENUI2*NB+2» = NOELTA 

001802 



LOCU(2*NB+l» = L0CU(2*NB) + LENU(2>N4B) 

001803 



LOCU(2*NB+2) = L0CUI2*NB+1» ♦ NBETA 

001804 

b 



001805 



CALL READ {TMDATA*N1 *N2tl t3 ) 

001806 



CALL READIM f IPDATAtNl*N2tl«3 ) 

001807 



CALL READ ICNT0TA,N1 tNCNPAR ,1 ,KCONT) 

001808 



NERROR = 18 

001809 



CALL READ ( WVtNl »N2 t1 *5) 

001810 



IF fN2 ,NE. 4) GO TO 999 

001811 



RCMAG = MVC4J 

001812 



GMAG = 0S0RTIGAMGICm*2 ♦ GAMGII2»*»2 ♦ GAM61I3)*>R2» 

001813 

cc 

HVC5) IS NOM RCMAGt WV(4) IS GHAG 

001814 



IF IGMAG .EQ. 0.0 0) GO TO 75 

001815 



IF (RCMAG .LE. l.D 0) GO TO 999 

001816 



DO 70 J=l,3 

001817 


TO 

GAMGI(J) s GAMGI(J)/GMAG 

001818 

? c 



001819 


75 

CALL PAGEHD 

001820 


i 


i 



I 
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LELO = 2*NB ♦ 2 
STARTT e TMDATA(l) 

OELTAT = TMDATA(2) 

ENOT = TMOATAOl 
NORRNT = IPDATAfl) 

NOPLOT = IPDATAC2) 

IFLNER s IPOATAO) 

G1 = 6HAG*GAMGm) 

G2 ^ GMAG*GAMGI(2) 

G3 = GMAG*GAMGI(3) 

WRITE (NOT,2O01» NB,NBMAX,STARTT,GltGAMGI(l l,NOPRNT,NHtNHMAX, 

* OELTAT tG ZvGAHGI f 2 » f NOPLOT ,NSPTf NSPMAX yENOTtGatG AHGI (3) t lELNER * 

* N 0 FM 0 fr« 1 WMAX»GMAGfRCMAG»NDELTA»NNW 60 DtNU»NMDB 0 D*NCETAfKHU, 

* NLAM,KY,NEO»KU 
WRITE (NOT, 2002) 

CALL WRITIS (ITOPOL,2,NH,2I 

WRITE (NOT, 2003 I 

CALL HRITIS ( 1H0ATA,7,NH,7) 

WRITE (NOT, 200 A) 

CALL WRITES (BETAH,6,NH,6 ) 

WRITE (NOT, 2005) 

CALL WRITES (BETAHD,6,NH,6) 

CALL PAGFHD 
WRITE (NOT, 2006) 

CALL WRITIS (IRGFLX,1,NB,1) 

WRITE (NOT, 2007) 

CALL WRITIS (NHPOI,l,NB,l) 

WRITE (NOT, 2008) 

CALL WRITIS (NSPOI,l,NB,l) 

WRITE (NOT, 2009) 

CALL WRITIS (NH0W,I1,NB,II> 

WRITE (NOT ,2010) 

CALI WRITIS (LENU,1,LEL0,1) 

WRITE (NOT, 2011) 

CALL WRITIS (LOCU,l,LELO,I) 

WRITE (NOT, 2012) 

CALL WRITIS (IFTSMW,1,NSPT,1) 

CALL PAGFHD 
WRITE (NOT, 2013) 

IF (NOFMO .NE. 0) WRITE (NOT, 2014) 

IF (NOFMO .NE, 0) CALL WRITIS ( IMO,3,NOFMO,3) 

IP (NOPMO ,NE. 0) WRITE (NOT, 2015) 

IF (NOFMO .NE. 0) CALL WRITES (AMO,2,NOFMO,2) 

NCNTRL = NCNPAR - NOELTA 

W^cITE (NOT ,2016) NCNTRL 

CALL WRITES (CNTOTA, 1, NCNPAR, 1 ) 

DO 20 N=1,NB 

IP (IRGFLX(N) .EO, 0) GO TO 25 
READ (NTT, 1001) NTYPE 


001821 

001822 

001823 

001824 

001825 

001826 

001827 

001828 

001829 

001830 

001831 

001832 

001833 

001834 

001835 

001836 

001837 

001838 

001839 

001840 

001841 

001842 

001843 

001844 

001845 

001846 

001847 

001848 

001849 

001850 

001851 

001852 

001853 

001854 

001855 

001856 

001857 

001858 

001859 

001860 

001861 

001862 

001863 

001864 

001865 

001866 

001867 

001868 

001869 

001870 


i 
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IF (NTYPE .EO. 11 CALL MSMODL <N» 001871 

IF (NTYPE -EO. 2» CALL HSMOOC (N) 001872 

TO TC 20 001873 

25 CALL MPIGID (Nl 001874 

C 001875 

20 CONTINUE 001876 

C 001877 

RETURN 001878 

999 WRITE (NOT ,21101 NERROR 001879 

STC»P 001880 

END 001881 


1 
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>p 

OYNSBB 


-001882 

► t 

IS OYNSBB 


-001883 

COMPILER (XMelltCEQUIV=CMNJ 


-001884 

SUBROUTINE PYNSBB 


-001885 

IMPLICIT DOUBLE PRECISI0N(A-H,O-Z) 


-001886 




001887 


COMMON /AMUBW / 


001888 

♦ 

AMU(15,15t 5),BW(30t 65) 


101889 


COMMON /CONPAR/ 


001890 


CNTOTA(IOO) 


9501891 


COMMON /ONAUX / 


001892 

♦ 

NAUX 


001893 


COMMON /HANDS / 


001894 

♦ 

HATHC3, 6» 8)«STGHf3. 6, 8),HATS(3» 6tl0) »SIGSf3* 6,10) 


401 895 


COMMON /ILINER/ 


001896 


IFLNER 


001897 


COMMON /INTGRL/ 


001898 

♦ 

AMC 78, 5),ACPF(9, 6, 5),BC0E(6, 6, 5), 


501899 

* 

COFll ( 6, 6, 5),C0F22( 6, 6, 5),C0F33e 6, 6, 5),AK( 6, 6, 

5), 

601900 

♦ 

C0F12( 6, 6, 5),C0F13f 6, 6, 5),C0E23( 6, 6, 5), ADI 6, 6, 

5), 

701901 


COFXYf 6, 6, 5),C0FXZf 6, 6, 5),C0FYZC 6, 6, 5) 


801902 


COMMON /MAXMUM/ 


001903 

♦ 

NBMAX ,nhmax,nspmax,nmwmax,nmwbod,nmdbod,kmu,ky,ku 


001 90A^ 


COMMON /MISCNO/ 


001905 

♦ 

NOPRNT, NOPLOT 


001906 


COMMON /NUMBRS/ 


001907 

♦ 

ZRO,ONE,TWO,TRES 


001908 


COMMON /PLTDTA/ 


001909 

♦ 

NRPLOT.NCPLOT 


001910 


COMMON /OPRKTA/ 


001911 


QRK(250),PRK(A) , NT 


1501912 


COMMON /SPECIF/ 


001913 

♦ 

BETAHC6, 5),BETAH0(6, 5),AM0(2, 5 ) ,RH(3,3,2A ) ,RS(3,3,20 ) , 


1601914 

♦ 

0H(3,28),DS(3,2O),IMOt3, 5),NM0MC5, 5) ,IFTSMW C 10) , 


1701915 


NB,NH,NSPT,EJOFMO,NDELTA,ITOPOLI2, 5),1RGFLX( 5),IH0ATA(7, 

5), 

1801916 

♦ 

LOCUf 12 ) , LENU ( 1 2 ) ,NU ,NBE TA ,NL AM ,NEO 


1901917 


COMMON /TAPE NO/ 


001918 

♦ 

NTAPE 1 , NTAPE2 ,NTAPE3 


001919 


COMMON /TIMESS/ 


001920 

♦ 

STARTT,DELTAT,T ,ENDT,TMST 


001921 


COMMON /VECTOR/ 


001922 

♦ 

Y(250),YDT(250) 


2001923 


COMMON /VINDEP/ 


001924 

♦ 

INDEP (250) 


2101925 




001926 

DATA NOT / 6/ 


001927 




001928 

FORMAT (////1X,47HTHE FOLLOWING INTEGER ARRAY (INDEP) PRESCRIBES 

001929 

♦54HINDEPEN0ENT VARIABLES «11, AND DEPENDENT VARIABLES (0), /IX 

Y 

001930 

* 

lOl(lH-)) 


001931 


o u 


i 


1 
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C 

PRKfl) = ONC/TMO 

PRK<2» = OVE - DSORTfPRKCin 

PRKC3I = TWO - PRKC2) 

PRK(4» = PRKIll 
C 

NT = 0 

T = START! 

TMST = ZRO 
C 

DO 100 I=1*NE0 
100 ORK(I) = ZRO 


REWIND NTAPEl 
C 

DO 2 1=1 tKY 
INDEP(I) = 1 
Y(I| = ZRO 
2 YOTHI = ZRO 
C 

00 3 N=1«NB 
NXE = IRGFIXCNI 
NP6 = 6 ♦ NXE 

READ (NTAPEl) ( (AMUfl, J»N) »J=lrNP6}«I=l«NP6) 
KNT = O 
DO 6 1=1,NP6 
DO 6 J=I,NP6 
KNT = KNT ♦ 1 
6 AH(KNTtN) = AMU(ItJfN) 

IF (NXF .EQ. 0) GO TO 3 
LXE = LOCUCN+NB) 

LXEO = LOCU(N ) ♦ 6 
LXEN = LXE ♦ NXE - 1 
LXEON = LX ED ♦ NXE - 1 

READ (NTAPEl) ( (ACOF (I, J»N) •J=1,NXE) *I=lt9) 
READ (NTAPEl) ( (6C0F ( I, J»N) »J=1 tNXE) «T=1«6) 
READ (NTAPEl) ( (COFXY(I«J»N)» J=l*NXE)tI=ltNXE) 
READ (NTAPEl) ( (CCFXZ( I» J»N)» J=ltNXE ) t 1 =1 tNXE) 
READ (NTAPEl) ( (COFYZ( I »J»N) • J=1»NXE ) t I-l tNXE ) 
READ (NTAPEl) ((COFll(I,JtN)t J=ltNXE) tI=ltNXE) 
READ (NTAPEl) ( (COF22( I tJ tN) » J=1 »NXE ) »I=1 tNXE) 
READ (NTAPEl) ((C0F33(ItJtN)tJ=ltNXE)tI=ltNXE) 
READ (NTAPEl) ( (C0F12( I«J tN) t J=ltNXE ) t Z=1 tNXE) 
READ (NTAPEl) ((C0F13(It«)tN)tJ)=ltNXE)tI=^ltNXE) 
READ (NTAPEl) ( (C0F23(I. JtN)t J=ltNXE ) tX=^l tNXE ) 
READ (NTAPEl) ((AK (It JtN)t J=ltNXE)tI-ltNXE) 
READ (NTAPEl) l(AD ( I t J tN) t J^ltNXE) tl =1 tNXE ) 

READ (NTAPEl) (Y(J)«J=:LXE tLXEN ) 

READ (NTAPEll (Y( J )• J=LXEDtLXEDN) 


001932 
001933 
001934 
001935 
001936 
001937 
001938 
001939 
001940 
001 941 
001942 
001 9 <>3 
001944 
001 94S 
001946 
01VI94Y 
001948 
001949 
001950 
001951 
001952 
001953 
001954 
001955 
001956 
001957 
001958 
001959 
001960 
001961 
001962 
001963 
001964 
001965 
001966 
001967 
001968 
001969 
001970 
001971 
001972 
001973 
001974 
001975 
001976 
001977 
001978 
001979 
001 980 
001981 


■I 
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READ (NTAPEll NHB 

CCC NOTE NHB IS NO. OF P/Q HINGES* NOT TO INCLUDE HINGE-1. 

CCC OVERLAYfl,OI MUST BE SURE OF THIS. 

DO 4 L=1«NHB 
READ (NTAPEII NOH 
CCCC NOH NOT TO INCLUDE HINGE 1 
LHS s 0 

IF (ITOPOLIl*NOH) .EQ. N) LHS = 2*NOH - 3 
IP mOPOL(2.NOH) .EO. N) LHS = ?*NOH - 2 
IF (LHS .LE. 0) GO TO 999 

READ CNTAPEl) ( (HATH! I * J* LHS) , J=1 *NXE ) » 1^1 *3 ) 

4 READ (NTAPEl) ( ( SIGHf I * J, LHS) * ,NXE) , I:^l*3 ) 

READ (NTAPEl) NSB 

IF (NSB .EO. 0) GO TO 3 
DO 5 L=1*NSB 
READ (NTAPFl) NOS 

READ (NTAPEl) ( (HATS ( I * J*NOS) » J=:l ,NXE ) * I-l *3 ) 

5 READ (NTAPEl) ( ( SIGS ( I* J*NOS) * *NXE ) * 1=1 *3 ) 

3 CONTINUE 

C 

DO 10 N=1*NB 

LTD = LOCIKN) + IRGFLX(N) + 5 
NMW = NH0W(1*N) 

IF (NMW .EO. 0) GO TO 10 
NMWVS = 0 
DO 15 I=1*NMW 
NOMW = NM0W(I-«-2*N) 

IF (IM0(3*N0HW) .EO. 0) GO TO 15 
NMWVS = NMWVS ♦ 1 
Y(LTD+NMWVS) = AMO(l,NOKW) 

15 CONTINUE 
10 CONTINUE 
C 

LBE = L0CU(24NR+1) - 1 
DO 20 J=1,NH 
00 20 1=1*6 
IPl = 1+1 

IF (IHDATA(IP1*J) .EO. 1) GO TO 20 
LBE = LBE + 1 
Y(LBE) = RETAH(I,J) 

20 CONTINUE 
C 

IF (NDELTA .EC. 0) GC TO 25 
LOE = LOCU(2*NB+2) - I 
DO 26 J=1*NDEITA 
L = LOE ♦ J 
26 Y(L) = CNTDTA(J) 

C 

25 CALL POTOH 
CALL RHGENR 


001982 

001983 

001984 

001985 

001986 

001987 

001988 

001989 

001990 

001991 

001992 

001993 

001994 

001995 

001996 

001997 

001998 

001999 

002000 

002001 

002002 

002003 

002004 

002005 

002006 

002007 

002008 

002009 

002010 

002011 

002012 

002013 

002014 

002015 

002016 

002017 

002018 

002019 

002020 

002021 

002022 

002023 

002024 

002025 

002026 

002027 

002028 

002029 

002030 

002031 


( 
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• 

CALL FINDU fO) 002032 

C 002033 

IPRNT = 0 002036 

IPLOT = 0 002035 

C 002036 

CALL YOOT 002037 

WRITE (NOTv2001i 002038 

CALL WRXTIS (INDEP»l»NEOt 1) 002039 

C 002040 

NCAM - NEO 002041 

NRAM NCAH * NAUX 002042 

C 002043 

CALL EN6M0M 002044 

CALL PRNTOU 002045 

IF IIFLNER .EO. II GO TO 50 002046 

CALL PLOTWR 002047 

11 CALL RKADAMCNEQ) 002048 

CALL ENGMOM 002049 

IPRNT = IPRNT ♦ 1 002050 

IF I IPRNT .NE. NOPRNT) GO TO 12 002051 

CALL P«»NTOU 002052 

IPRNT = 0 002053 

12 CONTINUE 002054 

IPLOT = IP LOT + 1 002055 

IF I IPLOT ,NE. NOPLOTI CO TO 13 002056 

CALL PLOTWR 002057 

IPLOT = 0 002058 

13 CONTINUE 002059 

IF IT .LT. ENDT) GO TO 11 002060 

RETURN 002061 

C 002062 

50 CALL LINEAR CNRAN«NCAM) 002063 

RETURN 002064 

C 002065 

999 WRITE (NOT •2010) 002066 

2010 FORMAT I IH 1 • 1 5HERR OR IN I TOPOL) 002067 

STOP 002068 

END 002069 


1 


i 


I 
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[HOG,P OYNSCC 
IFOR, IS DYNSCC 

COMPILER (XM=1),(EQUIV=CMNI 
SUBROUTINE DYNSCC 
C 

C *** 

C ♦♦♦ MSEC UNIVAC 1108 VERSION ♦♦♦ 

C *** 

DOUBLE PRECISION DUM 
C 

COMMON / INTGRl / ZP(1000,16),DUMfl500l,JVPLn6) 

DIMENSION ICTITLC10),NCD( 3I,PTITLE( 8) 

C 

COMMON /PLTOTA/ 

♦ NRPLOT.NGPLOT 

COMMON /TAPE NO/ 

♦ NTAPE1,NTAPE2,NTAPE3 
C 

DATA NITfNQT /5,6/ 

DATA KRPLOT,KCPLOT /1000,16/ 

C 

READ CNIT,1005) HCTITLI 11,1=1,101 
1005 FORMAT(10A6> 

CALL PAGEHD 

WRITE (NOT, 1001) ( ICTITLf I) ,1=1,10) 

1001 FORMAT (///,30X,31HSUMMARY OF PLOTTING INFORMATION//, lOX ,10A6 ) 

C 

READ (NIT, 1003) NSET 
1003 FORMAT(16I5) 

IF (NSET .EQ. 0) RETURN 

WRITE (NOT, 1011) NSET,NRPLOT,NCPLOT,KRPLOT,KCPLOT 

1011 FORMAT!//, 10X,10HNSET =15,/, 

♦ 10X,10HNRPLOT =15, 10X,10HNCPL0T =15,/, 

♦ 10X,10HKRPLOT =15, 10X,10HKCPLOT =15 ) 

C 

IF (NRPLOT .LE. KRPLOT) GO TO 1500 
MRPLOT = KRPLOT 
WRITE (NOT, 1009) 

1009 FORMAT (//,10X,A6HNRPL0T EXCEEDED KRPLOT AND WAS RESET TO KRPLOT) 
1500 CONTINUE 
C 

DO 1000 ISET=1,NSET 

REWIND NTAPE3 

»EAO (NIT, 1003) JPL 

IF (JPL .GT, KCPLOT) GO TO 998 

READ (NIT, 1003) ( JVPL(J),J=1, JPL) 

WRITE (NOT, 101?) ISET,( JVPL(J),J=1,JPL) 

1012 FORMAT!//, 10X,7HISET -- I5,/10X,7HJVPL =1615) 

C 

DO 2000 11=1, NRPLOT 


-002070 
-002071 
-002072 
-002073 
-002074 
-002075 
-002076 
-002077 
-002078 
-002079 
-002080 
-002081 
-002082 
-002083 
-002084 
-002085 
-002086 
-002087 
-002088 
-002089 
-002090 
-002091 
-002092 
-002093 
-002094 
-002095 
-002096 
-002097 
-002098 
-002099 
-002100 
-002101 
-002 102 
-002103 
-002104 
-002105 
-002106 
-002107 
-002108 
-002109 
-002110 
-002111 
-002112 
-002113 
-002114 
-002115 
-002116 
-002117 
-002118 
-002119 


! 


1 


! 
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READ INTAPE3) CDUMf I l,I=l»NCPLOT) 

DO ?001 J=1*JPL 
JC = JVPUJ) 

2001 ZPIII.J) = DUMfJC) 

2000 CONTINUE 
C 

20 READ 1NIT»1003) NCI » f NCD ( I ) t 1=1 t3)«NGRID 
IF INCI -EO- 0» GD TO 1000 
IFCNCI -GT. 1) NGRIO = 1 
IF INGRID .EO. 0» NGPID = 1 

READ |NIT»1004I T1TLI,TITLD,C PTITLEI I) ,1=1, 8) 

1004 F0RMATI2fA6,4X),8A6) 

MR ITEINOT, 1006 1 NCI, (NCD 111,1=1,3) ,NGRID, 

* TlTLl,TITL0,IPTITLEm,l=l,8l 

1006 F0RMATI//,15X,7HNCI =,I5,5X,7HNC0 =,3I5,5X,7HNGRID =,I5,/, 

* 15X,A6,5X,A6,5X,8A6) 

CALL PLTCAR(ZP,NCI,NCD,NRPL0T,NGR1D, 

* TITLl ,T ITLD ,PT1TLE, ICTITL, KRPLOT) 

GO TO 20 

C 

1000 CONTINUE 
C 

RETURN 

C 

998 WRITE (NOT, 1020 I 

1020 FORMAT! //,10X,34HERR0R IN PLOT INPUT DATA, STOP RUN) 

STOP 

C 

END 


-002120 
-002121 
-002122 
-002123 
-002124 
-002125 
-002126 
-002127 
-002128 
-002129 
-002 130 
-002131 
-002132 
-002133 
-002134 
-002135 
-002136 
-002137 
-002138 
-002139 
-002140 
-002 141 
-002142 
-002143 
-002144 
-002145 
-002146 
-002147 
-002148 
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tHDGtP DYNSDD 


-002149 

IFOR, IS OVNSOO 


-002150 


COMPILER (XM=n,fEQUIV=CMN) 


-002 151 


SUBROUTINE DYNSDD 


-002152 


IMPLICIT DOUBLE PRECISI0N(A-H,0-2) 

-002153 


REAL FMIN,FMAX,0BMIN,DBMAX, TITLE 

002154 


•EAL AMIN,AHAX 


002155 

C 



002156 

C 



002157 

C 

THIS OVERLAY PERFORMS THE LINEARIZEC 

1 SYSTEM ANALYSES - 

002158 

C 



002159 

C 



002160 

C 



002161 

C 

: DATA STREAM CONTROL 

, — 

002162 

C 

FOR T. iS OVERLAY 


002 163 

C 



002164 

C- 

LNAM 

FORMAT A4 

002165 

C 



002166 

c 

IF CLNAM .EQ. 4H ) RETURN 


002167 

c 

IF CLNAM ,EO. 4HT1MEI GO TO 400 


002168 

c 



002169 

C CALL RFAOIM (LRY,10,NCYC,10,KR ) 


002170 

c 



002171 

c 

NOTE LRY(1,J) = 

ITVPE 

002172 

c 

LRY(2,J) = 

ITFIN 

002173 

c 

LRY(3,J) = 

JTFOUT 

002174 

c 

LRYC4,J) = 

KPLOT 

002175 

c 

LRYC5,J) = 

lAFLG 

002176 

c 

LRY(6,J> = 

NO. B"S TO KEEP — ITYPE=7 

002177 

c 

LRY(7,J) = 

LOCAL ID. NO. OF B"S TO RETAIN. 

002178 

c 

LRY(8,J» = 

LOCAL ID. NO. OF B"S TO RETAIN. 

002179 

c 

LRY(9,J) = 

LOCAL ID. NO. OF B"S TO RETAIN. 

002180 

c 



002181 

c 



002182 

c 



002183 

c- 

CALL REAOIM C IRY,3 ,NCYC ,3 ,KR ) 


002184 

c 



002185 

c 

NOTE IRY(1,J) = 

ROOT TOLERANCE EXPONENT. 

002186 

c 

IRY(2,J) = 

GAIN TOLERANCE EXPONENT 

002187 

c 

IRY(3,J> = 

ROOT TOLERANCE EXPONENT 

002188 

c 


USED TO REMOVE SHIFT FREQ. 

002189 

c 


IN SUBROUTINE NUMS. 

002190 

c 



002 191 

c 

DO 500 ICYC = 1,NCYC 


002192 

c 



002193 

c- 

TITLE 

FORMAT C10A6) 

002194 

c- 

LPNAME 

FORMAT C5A4I 

002195 

c 



002196 

c 

DO 500 lOP =1,5 


002197 

c 



002198 


noon r>onooooonoooononoononor»ooooonor>onoono 
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IF (LPNAMFCIOP) 
IF (LPNAMEflOP) 
♦ .OR. LPNAMEIIOP) 
♦.OR. LPNAMEIIOP) 
♦.OR. LPNAMEIIOP) 
♦.OR. LPNAMEIIOP) 
IF ILPNAMEIIOP) 


.EO . AH ) GO TO 500 

.EQ. AHBODE 
.EO. AHNICH 
.EO. AHNYOU 
.FQ. AHBCNN 

.EO. AHNINY) GO TO 200 
.EO. AHROOT) GO TO 300 


GO TO 9999 


200 CONTINUE 


BODE, NICHOLS, NYOUIST SECTION 

FMIN, FMAX, DBHIN, DBMAX, AMIN, AMAX FORMAT I6F10.0) 

GO TO 500 

300 CONTINUE 

ROOT LOCUS SECTION 

CALL REAOIM IIJM, 2, NRLC, 2, KR) 

CALL READ IRIC, 7, NRLC, KR, KR) 

DO 350 IRC =1,NRLC 

350 CONTINUE 
GO TO 500 

AGO CONTINUE 

500 CONTINUE 
RETURN 


DIMENSIONED WORK SPACES — 


DIMENSION VS1I21A),VS2I107) 

DIMENSION LPNAMEI5) 

DIMENSION GNBI2) ,GD6 12) 

DIMENSION RRNI 50),RINI 50),RRDI 50),RIDI 50),R2R| 50),R2II 501 
DIMENSION IJMI2, 50),LRY|9, 50), IRYI3, 501, KBKPI3) 

COMMON BLOCKS 


COMMON /KDSIZE/ 

1 KR, KRT, KRX, KVl , KV2, KVX 
COMMON /LDSIZE/ 

2 NX, NY, NDLTA, NXSS, NB, NJQ, NY2, ND2 


002199 
002200 
002201 
002202 
002203 
002 20A 
002205 
002206 
002207 
002208 
002209 
002210 
002211 
002212 
002213 
002 21A 
002215 
002216 
002217 
002218 
002219 
002220 
002221 
002222 
002223 
002 22A 
002225 
002226 
002227 
002228 
002229 
002230 
002231 
002232 
002233 
00223A 
002235 
A1 202 236 
002237 
002238 
A1A02239 
A18022A0 
002 2 A1 
002 2 A2 
002 2 A3 
002 2AA 
002 2 A5 
002 2A6 
002 2A7 
002 2 A8 
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COMMON 

/LCOUNT/ 




002249 

3 

NNRf ICN» NNZ» NDRt ICDt NDZ 



002250 

COMMON 

/TAPENO/ 




002251 

4 

NUTl, NUT2t NUT3 




002252 

COMMON 

/MISCNO/ 




002253 

5 

NOPRNT, NOPLOT 




002254 

COMMON 

/LB DATA/ 




002255 

6 

FMINt FMAX» DBMIN* OBMAX 




002256 

COMMON 

/LTOL / 




002257 

7 

TDLN.TOLO 




002258 

COMMON 

/LTITLE/ 




002259 

e 

TITLE CIO) 




002260 

COMMON 

/LIJV / 




002261 

9 

IVf 50) • JV f 50) 




42002262 

COMMON 

/LRARAY/ 




002263 

A 

FBRN( 50) t FBNCf 50), FBROI 

50), 

FBOC( 

50) 

42202264 

COMMON 

/LROOT / 




002265 

B 

RC107) , RX 1214) 




42402266 

COMMON 

/ LVl / 




002267 

C 

VI ( 50), V2 C 50), V3 C 

50) 



42602268 

COMMON 

/ LV2 / 




002269 

D 

XVI ( 50), XV2 ( 50), XV3 ( 

50), 

XV4 ( 

50) 

42802270 

COMMON 

/VECTOR/ 




002271 

E 

Y (250), YD (250) 




43002272 

COMMON 

/LWORKl/ 




002273 

F 

Wl( 50, 50), W2( 50, 50) 




43202274 

COMMON 

/TIMESS/ 




002275 

G 

ST, DT, T, ET, TMST 




002276 

COMMON 

/PLTDTA/ 




002277 

I 

nrplot,ncplot 




002278 

002279 

002280 


—FOUI VALENCE MAP 




002281 


002282 

002283 

002284 

EQUIVALENCE ( VSl ( 108 ) ,VS2 ( 1 ) ) 43402285 

002286 
002287 
002288 
002289 
002290 
002291 
002292 
002293 
002294 
002295 
002296 
002297 
002298 


DATA STATEMENTS 


DATA LBODE. LROOT, LNYOU, LNICH» LN1NY» LTIME, LBLNK, LBONN/ 
♦ 4HBC30Ef4HR00T,4HNYeUt4HNICH,4HVINY,4HTIME,4H ,4HB0NN/ 

C 

DATA NIT/ 5/ 

DATA NOT/ 6 / 

C 

1003 FORMAT (20A4) 

1004 FORMAT (6FJ0.0) 
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1005 F0RMATI10A6I 

2001 FORMAT <//,5X,10H0N ICYC = ,1 2»26H,NUMERAT0R GAIN LESS THAN « 

♦ D10.4*16HWAS ENCOUNTERED. t//*5Xf 

♦ 47HPR0GRAM CONTINUING WITH NEXT TRANSFER FUNCTION.) 


SET UP FIXED INTEGER DATA 

KR » 50 

KRT = 107 
KRX = 2U 
KVl = 21A 
K.V2 = 107 
KVX - 50 

K3 = 3 
K9 = 9 

SET UP VARIABLE INTEGER DATA 

NY2 = NX - NDLTA - NXSS 
ND2 = NDLTA - NB 

REWIND NUT 2 
REWIND NUT3 

READ IN LINEARIZED PARTIAL DERIVATIVE MATRIX FROM UNIT NUT2 
PERFORM SIMILARITY TRANSFORMATION. AND PUT A* BACK ON NUT2. 

DO 50 L=1,NX 

50 READ (NUY2) (Wlf I«L) tI-l*NJG) 

REWIND NUT2 

WRITE (NUT?) ( (WlCIt^)tI::=ltKR)»J=l«KR) 

REWIND NUT2 

CALL WRITE C W1 »NJO ,NX ,3H-A-,KR ) 

CALL ORDRVR (Wl.MX.RRD.RID.KR) 

RFAD (NUT2 M (WKI, J),I=l,KR)tJ=l.KRI 
REWIND NUT2 
C 

CALL ASIMLR f W1 tW2 «I V«KR ) 

WRITE (NUT2) ( f W2f I. J) . 1=1 .KR ) » J=l ,KR ) 

REWIND NUT2 

CALL WRITE CW2,NX,NX.4H-A*-»KR) 

CALL ORDRVR (W2.NX tRRN.RIN.KR ) 

C REMOVE NUMBERS SMALLER THAN l.D-5 FROM ROOT ARRAYS. 

C 

CALL SIFT (RRD.NX.l.O-5) 

CALL SIFT (RIO .NX, l.D-5) 

CALL SIFT (RRN.NX. 1.0-5) 

CALL SIFT tRIN. NX, l.D-5) 

C 


02299 

002300 

002301 

002302 

002303 

002304 

002305 

002306 

43602307 

43802308 

44002309 

44202310 

44402311 

44602312 

002313 

002314 

002315 

002316 

002317 

002318 

002319 

002320 

002321 

002322 

00232? 

002324 

002325 

002326 

002327 

002328 

002329 

002330 

002331 

002332 

002333 

002334 

002335 

002336 

002337 

002338 

002339 

002340 

002341 

002342 

002343 

002344 

002345 

002346 

002347 

002348 
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CALL RWRITE C2 «RRO»R XDtRRN«RIN«NX»NXt4HRT At4HRTA*) 

READ (NUT? )((W2(If J)»T«1»KR),J-1*KR) 

REWIND NUT? 

C 

C READ IN C(3NTRni VARIABLEt LNAM AND BRANCH TO ARRROIATE SECTION. 
READ (NIT, 1003) LNAM 

IF (LNAM ,E0. LBLNK) RETURN 
IF (LNAM ,E0. LTIME) GO TO 400 

FREQUENCY DOMAIN ANALYSIS SECTION 


READ IN FREQUENCY ANALYSIS CONTROL VARIABLES 
CALL REAOIM (LRY,N5,NCYC,K9,KR) 


CALL READIM ( IRY ,N3, NC?,K3, KR ) 

IF (NC2 .NE. NCYC) GO TO 9999 

00 501 ICYC = l.NCYC 

ITYPE = LRYd.lCYC) 

ITFIN = LRY(2,ICYC) 

JTFOUT = LRY(3,ICYC) 

KPLOT = LRY(4,ICYC) 
lAFLG = LRY(5,ICYC) 

IF (ITYPE .EO. 0) GO TO 501 

IF (lABS (ITYPE) .LE. 6) GO TO 55 
NBKP = LRY(6,ICYC) 

DO 54 1=1, NBKP 

54 KBKP(l) = IRYI 1*6, ICYC) 

55 CONTINUE 


SET UP DEFAULT VALUES IN ARRAY IRY. 

IF (1RY(1,ICYC) .EO. 01 1RY(1,ICYC) = 
IF (IRY(2,TCYC) .EO. 0) IRY(2,ICYC) = 
IF (IRY(3,ICYC) .EO. 0) IRY(3,ICYC) = 
C 

TOLN = 10.00 IRY(1,1CYC) 

GTOL = 10.00 ♦♦ IRY(2,ICYC) 

PTOL = 10.00 ♦♦ IRY(3,ICYC) 

C 

TOLD = TOLN 
C 


002349 
002350 
002351 
002352 
002353 
002354 
002355 
002356 
002357 
002358 
002359 
002360 
002361 
002362 
002363 
NERROR = 0 002364 

002365 
002366 
002367 
002368 
002369 
002370 
002371 
002372 
002373 
002374 
002375 
002376 

NERROR = 1 002377 

002378 
002379 
002380 
002381 
002382 
002383 
002384 
002385 
002386 
002387 
002388 

-7 002389 

-7 002390 

-7 002391 

002392 

002393 

002394 

002395 

002396 

002397 

002398 
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c 002399 

IF (lABSlITYPE* .LT. 1 .OR. ITYPF .GT. 7) GO TO 9999 002400 

C 002401 

READ INIT.1005) TITLE 002402 

C 002403 

READ (NUT2) I IW2(I *J )*I=^1,KR) ,J=:1,KR) 002404 

REWIND NUT2 002405 

C 002406 

CALL TFTYPF IW2,Wl,Vl«NXtNA,ITYPE,ITFIN»NBKPtKBKP,KR»KR) 002407 

CALL WRITE f W1 ,NA«NA »4H-AR-tKR ) 002408 

CALL WRITE ( VI ,1 »NA.4HBC0L »1 ) 002409 

WRITE CNIJT3) ( tWl f I* J ) »T=1 »KR ) * J=1 ,KR ) 002410 

REWIND NUT3 002411 

002412 

NOW HAVE REDUCED TF A* ON NUT3. 002413 

002414 

OBTAIN ROOTS FOR DENOMINATOR. 002415 

002416 

DO 57 I-1tNA 002417 

DO 57 J=1»NA 002418 

57 W2fI«J) = Wl(Jtl) 002419 

002420 

CALL ORDRVR fWl,NA,RRD,RIOtKR > 002421 

CALL SIFT fRRD*NA,TOLO) 002422 

CALL SIFT <«ID,NA,TOLD) 002423 

002424 

CALL ORDRVR (W2»NAtV2tV3,KR ) 002425 

CALL SIFT (V2,NA*T0Ln» 002426 

CALL SIFT (V3tNA,T0LD) 002427 

CALL RWRITF (2tRRD,RlD,V2,V3tNA,NA#4HR ARt4HRARTI 002428 

002429 

IF IIAFLG .EQ. 0) GO TO 59 002430 

DO 58 I=1»NA 002431 

RRD(I) = V2in 002432 

58 RIDCn = V3(I» 002433 

59 CONTINUE 002434 

002435 

OBTAIN ROOTS OF NUMERATOR. 002436 

002437 

READ (NUT3) ( I W1 * I , J ) , 1=1 ,KRJ , J=1 ,KR I 002438 

REWIND NUT3 002439 

C OBTAIN ABSOLUTE JTF LOCATION BASED UPON LOCAL JTFOUT. 002440 

JTF = NY2 ♦ JTFOUT 002441 

IF (lABSflTYPFI .EQ. 21 JTF = ND2 + JTFOUT 002442 

IF aABSClTYPEI .EO. 3) JTF = JTF + NXSS ♦ N02 002443 

IF IIABSIITYPE) .EO. 7 1 JTF = JTF 4 NXSS 4 N02 002444 

CALL NUMS (W1,W2,V1,RRN,RIN,R2R*R2T,PT0L* 002445 

♦ GAIN* IFLGfNNUH«NZRO« JTF yNAtKR) 002446 

^ 002447 

NN = NZRO 002448 
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ND = NA 
C 

IF (IFLG .NE. 0) GO TO 65 
CALL PAGEHO 

WRITE (N0T,?001> ICYC.GTOL 
GO TO 75 
65 CONTINUE 
C 

CALL SIFT IRRN.NN.TOLNI 
CALL SIFT (RIN,NN,TOLN» 

CALL DCQRRT (RRN,RINSNNtNNR»ICN*NNZ«Vl*V?) 

CALL DFORHB (NNR »ICN «V1 »V2tFBRN»FeNCfV3 tl.DO»GAIN,GNB ) 
C 

70 CONTINUE 
C 

CALL RWRITE (2»RRN»RIN»RRDtRIDtNN«ND,AH NUM,4H DEN) 

C 

CALL DCQRRT (RRD.R ID «ND,NDR «ICD*NDZ*V1 » V2) 

CALL DFORHB (NDR*IC0*Vl«V2«FBRD»FBDCtV3»l.D0*l.D0tGDB ) 
GB = GNBI2)/GDB(?) 

ESTABLISH WORKING ROOT COUNTS - 

KWR = NNR 
KOR = NOR 
KNZ = NNZ 
KOZ = NOZ 
KCN = ICN 
KCD = ICO 

CALL ZFRO (XVltl tKVXtl) 

CALL ZERO IXV2»1»KVX,1) 

CALL ZERO (XV3»1,KVX*1 ) 

CALL ZERO (XV4«1,KVX»1 ) 

IF (KNR -EQ. 0) GO TO 2202 
DO 201 1=1 ,KNR 

201 XVICI) = FBRN(I) 

2202 CONTINUF 

IF (KOR .EQ. 0) GO TO 2203 
DO 202 l=lfKOR 

202 XV3(1) = FERD(I) 

2203 CONTINUF 

IF (KCN ,EQ. 0) GO TO 2204 

K=2*KCN 

DO 203 1=1 ,K 

203 XV2(I) = FBNC(I) 

2204 CONTINUE 

IF (KCO. EG. 0) GO TO 205 
K=2*KCD 


002449 

002450 

002451 

002452 

002453 

002454 

002455 

002456 

002457 

002458 

002459 

002460 

002461 

002462 

002463 

002464 

002465 

002466 

002467 

002468 

002469 

002470 

002471 

002472 

002473 

002474 

002475 

002476 

002477 

002478 

002479 

002480 

002481 

002482 

002483 

002484 

002485 

002486 

002487 

002488 

002489 

002490 

002491 

002492 

002493 

C»02494 

002495 

002496 

002497 

002498 
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i 


DO 20A 1=1 »K 

204 XV4(II = FPOCdl 

205 CONTINUE 


REMOVE REAL ZEROS PRIOR TO CALL TO TTFF 

IF IKNR .NE. 01 CALL RMVZRO (XVIvKNR) 

IF (KOR .NE. 0) CALL RMVZRO IXV3«KDR) 
CALL ZERO fR,l,KRT,ll 

CALL TTFF |KNR,KCN,KNZ,KOR,KCO,KDZt 
♦ GBfXVl,XV2tXV3,XVA,R,KRT| 

CALL CANCOR (Rl 


READ IN DISPLAY CONTROL VARIABLES. 
75 READ (NIT* 10031 LPNAME 


DO 500 lOP =1,5 


IF (LPNAME(IOP) 

.EO. 

LBLNK 

) 

GO 

TO 

500 

IF (LPNAME(IOP) 

.EO. 

LBODE 





♦-OR. LPNAME(IOP) 

.EO. 

LNICH 





♦.OR. LPNAMFflOP) 

.EO. 

LNYQU 





♦.OR. LPNAME(IOP) 

.EO. 

LBONN 





♦.OR. LPNAME(IOP) 

.EO. 

LNINY 

) 

GO 

JO 

200 

IF (LPNAMEIIOP) 

.EO. 

LROOT 

) 

GO 

TO 

300 


60 TO 9999 


NERROR = 2 


200 CONTINUE 


FREQUENCY RESPONSE PROCESSING 

READ (NIT, 1004) FMIN, FMAX, DBMIN, DBMAX, AMIN* AHAX 
IF (IFLG .EO, 0) GO TO 500 
C 

KNR = RCll ♦ O.lOO 
KCN = R(2) 4 O.IDO 
KNZ = R(3) 4 O.IDO 
KDR = R(4) 4 0.100 
KCD = R(5) 4 O.IDO 
KOZ = R(6) 4 O.IDO 
CALL WRITE (R,1,KRT,4HRRED,1) 

C 

CALL ZERO (XV1,1,KVX,1) 

CALL ZERO (XV2,1,KVX,1) 

CALL ZERO (XV3,1,KVX,1) 

CALL ZERO CXV4,1,KVX,1) 


002499 

002500 

002501 

002502 

002503 

002504 

002505 

002506 

002507 

002508 

002509 

002510 

002511 

002512 

002513 

002514 

002515 

002516 

002517 

002518 

002519 

002520 

002521 

002522 

002523 

002524 

002525 

002526 

002527 

002528 

002529 

002530 

002531 

002532 

002533 

002534 

002535 

002536 

002537 

002538 

002539 

002540 

002541 

002542 

002543 

002544 

002545 

002546 

002547 

002548 
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IF tKNR .FQ. 0) GO TO 2207 

DO 206 1=1 ,KNR 

L=7+I 

206 XVI (I) = RCL> 

2207 CONTINUE 

IF fKCN .EQ. 0) GO TO 2208 

K=2*KCN 

no 207 1=1 ,K 

L=7+KNR+I 

207 XV2«II = RfL) 

2208 CONTINUE 

IF IKDR .EO. 0> GO TO 2209 
00 208 I=1,KDR 
L = 7+KNR*2*KCN*I 

208 XV31I) = RfL) 

2209 CONTINUE 

IF (KCD .EO. 0) GO TO 2210 
K=2*KC0 
00 209 1=1 ,K 
L=7+KNR+2*KCN+KDR+I 

209 XVMI) = RCLI 

2210 CONTINUE 

EXTEND REAL ARRAY COUNTS TO INCLUDE REAL ZEROS. 

KNR = KNR ♦ KN2 
KOR = KOR + KDZ 


■PERFORM THE FREQUENCY RESPONSE. 


CALL SFREQ2 (KNR ,KCNtKDRtKCD»GB» 

1 XVI •XV2.XV3.XV4, FMIN ,FMAX t TITLE ) 

C 

IF (KPLOT .EQ. 01 GO TO 220 
IF (LPNAME(IOP) .EO. LBOOE 

♦ .OR.LPNAME(IOP) .EQ. LBONN) 

♦ CALL SPLOT (TITLE. FMAX, FMIN, DBMIN.OBMAX) 
C 


IF (LPNAME(IOP) .EO. LNICH 
♦ -OR.LPNAKE(IOP) .EQ. LNINY 

*.OR,LPNAME(IOP) .EQ, LBONN) CALL NIPLOT (TITLE ,DBMIN,DBMAX) 


IF (LPNAME(IOP) .EQ. 

♦ .OR.LPNAME(IOP) .EO. 

* .OR.LPNAMF(IOP) .EQ. 

GO TO 500 

220 CALL PAGEHO 

WRITE (NOT, 221) ICYC, 

221 FORMAT (//,10X, 


LNYQU 

LBONN 

LNINY) CALL NYPLOT (TITLE, AMIN, AMAX ) 


LPNAME(IOP) 
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* 48HN0 FREQUENCY RESPONSE PLOTS GENERATED ON ICYC = 13* 

* //,10X*9HLPNAME = A4) 

GO TO 5G0 

300 CONTINUE 

— ROOT LOCUS SECTION 


CALL RTOP CR,RX,VS1*KRX) “ 

NP = RXm ♦ l.DO 
NO = RXI2) ♦ l.DO 

DO 320 1=1 *NP 
J=I*2 

320 XVl(I) = RXIJI 
DO 325 1=1, NO 
J = I+2+NP 
325 XV2(I) = RXfJI 

CALL WRITE CXV2,1,N0,4HPDEN,U 
CALL WRITE ( XVI *1,NP ,4HPNUM ,1) 


READ IN ROOT LOCUS CONTROL VARIABLES. 

330 CALL READIM ( IJM,NR2 *NRLC,2*KR) 

IF IIFLG .EO. 0) GO TO 340 

NERROR = 3 

IF CNR2 .NE. 2 .OR. NRLC .GT. KR » GO TO 9999 

NOTE IJM(1,J) = ISNIH(J) 

IJM(2,J) = ELE. LOCATION IN ROOT ARRAY 
FOR STARTING ROOT LOCUS. 

340 CALL READ <W1 ,NR2,NC2,KR,KR ) 

IF IIFLG .FO. 0) GO TO 500 

NERROR = 4 

IF CNR2 .NF. 6 .OR. NC2 .NE. NRLC) 60 TO 9999 

N0TE.....WH1,J) = THETAOfJ) 

W!(2*J) = SCL 
WI(3,J) = ALOC 
W1(4*J) s XMIN 
W1I5,J) = xr iX 
W1I6*J) = YMAX 

DO 350 IRC = l.NRLC 


ISNIM = IJMIltIRC) 
JJ = 1JMI2,IRC) 


002599 

002600 

002601 

002602 

002603 

002604 

002605 

002606 

002607 

002608 

002609 

002610 

002611 

002612 

002613 

002614 

002615 

002616 

002617 

002618 

002619 

002620 

002621 

002622 

002623 

002624 

002625 

002626 

002627 

002628 

002629 

002630 

002631 

002632 

002633 

002634 

002635 

002636 

002637 

002638 

002639 

002640 

002641 

002642 

002643 

002644 

002645 

002646 

002647 
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^ 002649 

THETAO = wm,IRCI 002650 

SCL s W1(2,IRC) 002651 

ALOC = W 1(3, IRC I 002652 

XMIN = M1(4,IRC) 002653 

XMAX = W1(5,IRC) 002654 

YMAX = W1(6,IRC) 002655 

002656 

LOCATE PROPER STARTING ROOT, 002657 

002658 

IF (ISMIM .ME. II GO TO 341 002659 

002660 

ROOT IS AN OPEN LOOP ZERO. 002661 

002662 

SR = RRN(JJ) 002663 

SI = RIN(JJ) 002664 

GO TO 342 002665 

341 CONTINUE 002666 

002667 

ROOT IS A POLE. 002668 

002669 

SR = RRD(JJ) 002670 

SI = RIO(JJ) 002671 

342 CONTINUE 002672 

002673 

CALL RLOCUS (XV1,XV2,SCL,SR,SI,NP,N0, THETAO, 002674 

1 XMIN, XMAX, YMAX, ALOC I 002675 

002676 

IF (KPLOT .EO. II CALL RLPLOT (TITLE, ISNIM,ICVC,IRCI 002677 

002678 

350 CONTINUE 002679 

002680 
002681 

GO TO 500 002682 

400 CONTINUE 002683 

002684 

LINEARIZED TIME RESPONSE SECTION 002685 

002686 

READ (NUT2I ( (W1 (I ..H , IM ,KR| , J-i ,kR| 002687 

REMIND MUT2 002688 

CALL LTRESP 002689 

RETURN 002690 

002691 

500 CONTINUE 002692 

501 CONTINUE -002693 

002694 
002695 

RETURN 002696 

C 002697 

99P9 WRITE (NOT, 19991 NERRPR 002698 


1 1 1 I I 1 J 1 
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1999 FORMAT ( IHlt //10Xf44HERR0R ENCOUNTERED IN DYN3D0« NERROR = » >002699 

* I3t/10Xtl6HPR0GRAM STOPPED.! 002700 

STOP 002701 

C 002702 

END -002703 


71 

(HDGtP DYNSEF -002704 

(FOR»IS OYNSEE -002705 

COMPILER IXM=1),(E0UIV=CMN) -002706 

SUEROUTINE OYNSEEf IFLNER*NOPLOTI -002707 

DIMENSION ADARYI22I -002708 

CALL 10ENm9,ADARY) -002709 

IFCIFLNER -EG. 1) CALL OYNSOO -002710 

1F(N0PL0T .GT. 0) CALL DYNSCC -002711 

CALL ENOJOB -002712 

RETURN -002713 

END -002714 
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[HDGtP ENGMOM 
iFORtTS ENGMOM 

COMPILER (XM=1I,CE0U1V=CMN| 

SUBROUTINE ENGMOM 

IMPLICIT DOUBLE PRECISION! A-H.O-ZI 
C 

COMMON /BHBSRO/ 

* BH(6,1?» 9),BS!6,12«10)»R0L(3«3t 51»D0L(3» 51 

COMMON /INTGRL/ 

* AM! 78, 5),AC0F!9, 6, 5I,BC0F!6, 6, 5), 

* COF11 ! 6, 6, 5),COF22! 6, 6, 5>,COF33! 6, 6, 5),AK! 6, 6, 5), 

* COF12! 6, 6, 5),COF13! 6, 6, 5),COF23! 6, 6, 51, AD! 6, 6, 5), 

♦ COFXY! 6, 6, 5),COFXZ! 6, 6, 5l,COFYZ! 6, 6, 5) 

COMMON /MAXMUM/ 

* NBMAX ,NHMAX,NSPMAX,NMHMAX,NMWBOD,NMDBOD,KMU,KY,KU 

COMMON /MOMENG/ 

♦ P! 65 »,PM0M!3O| ,HT0T!3»,T0TL!3»,ENGKE! 5I,ENGPE! 5» , 

♦ TOTKE, TPTPE, TOTEN6, AHTOT,ATOTL 

COMMON /NUMBRS/ 

♦ ZRO,ONE,TWP,TRES 

COMMON /SPECIF/ 

* BETAM!6, 5},BETAHD!6, 5l,AMO!2, 5) ,RH!3,3,2A) ,RS!3,3,20), 

♦ DH(3,28),DS!3,20),IM0!3, 5l,NMOH!5, 5) ,IFTSMW!10I , 

♦ NB,NH,NSPT,NOFMC,NDELTA,1TOPOL!2, 5I,IRGFLX! 5),IHDATA!7, 5), 

* LOCU! 1? ) ,LENU ! 1 2 ) ,NU ,NBETA ,NLAM ,NEO 

COMMON /VECTOR/ 

♦ Y!250I,Y0T!250) 

C 

DIMENSION HV! 6) 

DIMENSION VW!3) 

C 

KM = NMDBOD 

DC 5 1=1,3 

HTOTdl = ZRO 
5 TCTL!I» = ZRO 
DO 10 N=1,NB 
LA = 6*N - 5 
LL = LA ♦ 3 
LOA = L0CU!N1 
LOL = LOCUIN) ♦ 3 

CALL MULT3 !ROL! 1,1 ,N) ,P I LOA ) ,PMOM!LA ) ,3,3,1,3,1 ,1) 

CALL MULT3 !R0L!1 ,1 ,N) ,P!LOL) ,PMOM!LL ) ,3,3,1, 3,1 ,1) 

PMOM!LA I = PMOM!LA )-»DOL!2,N)«PMOM!LL-»^2)-DOL!3,N)*PMOM!LL-M) 
PMOM!LA+n = PM0M!LA+1»+00L!3,N)*PM0M!LL )~00L!l,N»*PH0M!LL+2» 

PM0M!LA+2) = PMOM!LA-»2|-«-OOL!l,N|*PMOM!LLMI-DOL!2,N)*PMOM!LL I 
CCC STATEMENTS THRU 40 TO ACCOUNT FOR ANGULAR MOMENTUM DOE TO 
CCC CONSTANT SPEED MOMENTUM WHEELS. 

NM = NM0W!1,N| 

IF !NM .EQ. 0) GO TO 40 
DO 30 1=1, NM 
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NW = NM0H(2+I»N) 002765 

IF fIN0f3»NW) ,NE. 01 GO TO 30 002766 

NA = IM0f2tNIWI 002767 

NS = IMOfltNM) 002768 

PH s AMOn tNW)*AM0(2»NW) 002769 

DO 35 J=l*3 002770 

35 VWCJI - PH*BS(NAtJtNS} 002771 

CALL MULTAO (P0L( 1 «1 tN ) »VH»PM 0M(LAI«3 »3 »1*3 tl *11 002772 

30 CONTINUE 00277-=i 

40 CONTINUE 002774 

00 15 I*lf3 002775 

11 = LA - I ♦ I 002776 

12 s LL - 1 ♦ I 002777 

HTOTdl = HTOT(l) ♦ PMOH(Il) 002778 

15 TOTLdI = TOTLd) ♦ PM0MCI2) 002779 

10 CONTINUE 002780 

C 002781 

TOTKE = ZRO 002782 

DO 20 N=1»NB 002783 

LOU = LOr.U(N» 002784 

LO = LOCl»(N+NP) 002785 

ENGPE(N) = ZRO 002786 

LE = LENUfN+NB) 002787 

LEU = LENUCN) 002788 

IF ILE .EG. 0) GO TO 22 002789 

CALL MULT3 ( AKd , 1 ,N) »Y( LO) yWV^LE »LE » 1 ,KM« 1 «I) 002790 

CALL MULT3 (Y(LO) ,WV»ENGPE(N)tltLE,l»I«l»l ) 002791 

ENGPE(N) = ENGPECN)/TWO 002792 

22 CALL MULT3 fY(LOU)»Pf LOU) *ENGKE(N) »1 , LEU,1 ,1 »1,1 ) 002793 

ENGKE(N) = EMGKE<N)/TH0 002794 

TOTKE TOTKE ♦ ENGKE(N) 002705 

20 TOTPE = TOTPE ♦ ENGPE(N) 002796 

TOTENG = TOTKE ♦ TOTPE 002797 

ATOTL = DSORTCTOTLCl )**2 ♦ TOTL(2)**2 ♦ TOTL(3)**2) 002798 

AHTOT = OSORTCHTOTd )*92 + HTOT(2)**2 •» HT0T(3)**2) 002799 

C 002800 

RETURN 00280! 

END 002 802 


[ 
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[HOG»P EQAOD 
(FOR* IS EQAOD 

COMPILER (XH=ll*(EOUIV=CHN) 

SUBROUTINE EQAOD 

IMPLICIT DOUBLE PRECISION (A-H,0-Z» 

C 

COMMON /BHBSRO/ 

♦ BH(6. 1?. 91 •BS(6»12*10I*R0L(3*3* 51*DOL(3* 5) 

COMMON /DNAUX / 

♦ NAUX 

COMMON /MAXMUM/ 

♦ NBMAX,NHMAX*NSPMAX«NNWNAX*NMWBOD;NMDBOD*KHU,KY«KU 

COMMON /SPECIF/ 

♦ 6ETAH(6, 5}*BETAHD(6* 5)*AMO(2* 51 »RH(3»3«24) «RS(3»3,20I» 

♦ 0H(3«28}*DS(3«20)*IM0(3* 51fNMGM(5* 5) »IFTSMW(10)* 

♦ Ne,NH*NSPT*NOFMO*NDELTA*ITOPOL(2* 5I*IRGFLX( 5)*IHDATA(7, 51* 

♦ LOCU(12I.LENU(12)*NU,NBETA*NLAM»NEO 

COMMON /VECTOR/ 

♦ Y (250 ),VDT( 2501 
C 

NAUX = 6 

LOEL = LOCU(2*NB+2» - 1 
ACON = 57-295800 

YOTINEO+ri « AC0N«R0LI3»2*1)/R0L(3»3*1 ) 

YOT(NEO+2» * '-AC0N*R0L(3*l»l)/R0L(3«3*n 
YOT(NEO+3» sr AC0N9P0L(2»ltl)/R0L(2»2*ll 
Y0T(NEQ+4» = Y(L0EL*2) 

Y0T(NEQ-»5> Y(L0EL^4| 

Y0T(NEC+6» = Y(L0EL+6) 

RETURN 

END 
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tHOGfP EXTOR 
TFORflS EXTOR 

COMPILER f XMsn»fEQUIVsCMN) 
SUPROUTIME EXTOR ITEXtlSPNtNTEX) 
IMPLICIT DOUBLE PRECISION IA-H,0-Z) 
DIMENSION TEX(6fl)» ISPNfll 
C 


COMMON /MAXMUM/ 

♦ . NBMAX,NHMAXtNSPMAX«NMWMAX»NMWBOD«NMDBOD,KMU»KY,KU 

COMMON /SPECIF/ 

♦ BETAH(6* 5»,BETAHD(6, 5)»AMOf2r 5 ) «RHf3,3*2A) ,RS (3,3,20 ) • 

♦ 0H(3,28),DS(3,20) ,IH0(3, 5),NM0W(5, 5) , IFTSMWflO) , 

♦ NB,NH,NSPT,N0FM0,NDELTA,IT0P0L(2, 5»,IRGFLX( 5I,IHDATA(7, 

♦ L0CU(12I,LENUI12»,MU,NBETA,NLAM,NEQ 

COMMON /VECTOR/ 

♦ Y(250I,V0TC250) 


C 


DATA IlST / 0 / 
C 


CCC ESTABLISH THE EXTERNAL FORCE/TOROUE (6-LONG VECTOR I AND NUMBER 
CCC THE CORRESPONDING SENSOR POINTS. ALSO ESTABLISH THF NUMBER OF 
CCC SIX-LONG VECTORS INTEX). 

C 

IF (IlST .EO. II GO TO 5 
II ST = 1 
DO 10 1st, 6 
DO 10 J=1,NSPMAX 
10 TFXfI,JI = 0.0 0 
C 


5 NTEX = 0 


C 


RETURN 

END 
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[HOGtP FETCH -002867 

tFORtlS FETCH -002868 

COMPILER (XM=11,IEQUIV=CMNI -002869 

SUBROUTINE FETCH(NTAPE,NRECNfNRECO,A*NRAfNCA*KRA) 002870 

IMPLICIT DOUBLE PR EC IS ION I A-H, 0-2) -002871 

002872 

FETCH MATRIX FROM NTAPE - ASSUMED WRITTEN BY ROWS 002873 

WHERE K-RECN = INPUT RECORD NUMBER DESIRED 002874 

NRECO = OUTPUT RECORD NUMBER FETCHED 002875 

^ = array where record STORED INRA.NCA) 002876 

002877 

DIMENSION AfKRAtl) 002878 

C 002879 

IFCNRECN - NRECO) lt2,3 002880 

C 002881 

1 REMIND NTAPE 002882 

NSKIP = NRECN - 1 002883 

IFCNSKIP .EO. 0) GO TO 20 002884 

DO 10 K=l, NSKIP 002885 

10 REAOINTAPE) DUM 002886 

GO TO 20 002887 

C 002888 

2 BACKSPACE NTAPE 002889 

GO TO 20 002890 

C 002891 

3 NSKIP = NRECN - NRECO - 1 002892 

IFCNSKIP ,F0- 0) GO TO 20 002893 

DO 11 K=l, NSKIP 002894 

11 REAOCNTAPE) DUM 002895 

GO TO 20 002896 

C 002897 

20 NRECO = NRFCN 002898 

C ' 002899 

REAOCNTAPE) C CACIt J) »J=1»NCA) «Isl»NRA) 002900 

C 002901 

RETURN 002902 

end 002903 


CHOG*P FINOT 
t FOR# IS FINOT 

COMPILER |XM=1)«(EQUIV=CMNI 

SUBROUTINE FINOT IC#MCN#NX#NS*T#NRFT.KC#KT) 

IMPLICIT DOUBLE PRECISION I A-H.O-Z I 
DIMENSION C(KC«1I* TfKT.If 
DIMENSION IVECaOT)# JVEC 11071 
C 

DATA FPS , NOT / l.D-15, 6 / 

1001 FORMAT C/// 5X#36HSU6R0UTINE FIND TERMINATED, SING. AT I5» 
C 

DO 5 1=1 #NX 
5 JVEC (I) = 1 
C 

DO lO L=1,NCN 
JBIG = 1 

A = DABS(C(L#1)I 
DO 15 J=2,NS 
AT = DABS(CfL#JI) 

IF lAT .LT. A) GO TO 15 
A = AT 
JBIG = J 
15 CONTINUE 

TVECdl = -JBIG 
JVECIJBIGI = 0 
IF CA .GT. EPS! GO TO 20 
WRITE (NOT, 1001) L 
STOP 

20 CONTINUE 

CL JBIG = C(L,JBIG) 

DO 17 J=1,NX 

17 C(L,J) = C(L,J)/CLJBIG 
00 25 1= 1, NCN 
F = C(!,J61G) 

IF IT «E0. L) GO TO 25 
DO 30 J=1,NX 

30 CCI,J) = C(1,J) - F*CCL,J) 

25 CONTINUE 
10 CONTINUE 
C 

NVAL = 0 
00 40 1=1, NX 

IF (JVEC (I I .EQ. 0) GO TO 40 
NVAL = NVAL ♦ 1 
JVEC (I) = NVAL 
40 CONTINUE 
C 

NRET = NX - NCN 

CALL ZERO (T,NRET,NRET,KTI 

GALL REVAOD I 1 .00,C , IVEC, JVEC ,T,NCN,NX,NRET,NPET,KC ,KT) 
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002954 

DO 50 I=ltNX 

002955 

IF CJVECCI* .EQ. 0) GO TO 50 

002956 

NR = JVEC(I) 

002957 

TlIfNRI - 1.00 

002958 

CONTINUE 

002959 


002960 

RETURN 

002961 

END 

002962 
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[HDG»P FINDU 
[FOR, IS FIWOU 

COMPILER (XM^Dt fEQUIV=CMN) 

SUBROUTINE FINDU (IFLAG) 

IMPLICIT DOUBLE PRECISION (A“H,0-Z» 

C 

DIMENSION ICONOOIt IVECOOlt JCONf 65}tRf30l 
C 

COMMON /AMUBW / 

♦ AMU(15tlS« 5)t6W(30t 65) 

COMMON /BHESRD/ 

♦ BH(6»1?» 9) »BS(6»12tlO)«ROLf3t3« 5)»DOL(3» 5) 

COMMON /NUMBRS/ 

♦ ZROtOKTfTWOtTRES 

COMMON /SPECIF/ 

♦ BETAH(6, 5)«BETAH0(6» 5) tAMOIZ* 5) tRHf 3»3tZ4) »RSf 3f3*20) » 

9 DHf3t 28),0S(3f20)tIN0(3, 5)tNMOWI5t 5) t IFTSMWI 10) * 

♦ NB,NH,NSPT,N0FM0,NDELTAtIT0P0LC2t 5)*IRGPLX( 5)tIHDATA(7» 

♦ LOCU( 12)tLENU(l?)tNU»NRETA»NLAMtNE0 

COMMON /TIMESS/ 

♦ STARTT»DELTAT,T,ENOT,TMST 

COMMON /VECTOR/ 

♦ YI250 ),YDT(250) 

COMMON /VINOEP/ 

♦ INDEP(250) 

C 

DATA EPS .NOT / 1.0-06, 6/ 

C 

IF (IFLAG .EQ. 2 ) GO TO 100 
IF (IFLAG .FO. 1) GO TO 110 
NCN = 6*NH 
DO 205 L=1 ,NCN 
TVEC(L) = 0 
205 IC(?N(L) = 1 

DO ?07 J=1,NU 
207 XON(J) = 0 
DO 210 N=1,NB 
JU = LOCU(N) - 1 
JRNG = 6 

IF (NH .GT. NB) JRNG ~ 6 * IRGFLX(N) 

DO 210 J=1 .JRNG 
210 JCON(JU-^J) = 1 
NR * 0 

00 215 J=1,NH 
DO 215 1=1 ,6 
IPl = I + 1 
NR = NR ♦ 1 
R«NR) = BETAHD(I.J) 

IF (IHDATA (IPlfJ) -EO. 1) R(NR) = ZRO 
IF (IHDATA (IPl, J) .EQ. 2) P(NR) = ADT(NR,T) 
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BETAHDdvJI = RCNRI 003013 

215 CONTINUE 003014 

003015 

GO TO 150 003016 

110 DO 220 LsltNCN 003017 

IVEC(L) = 0 003018 

220 ICONfLt = 0 003019 

DO 221 J = IfNU -003020 

221 INOEPIJ) = 1 -003021 

nr s 0 003022 

DO 225 J=ltNH 003023 

DO 225 1*2,7 003024 

NR = NR ♦ 1 003025 

ICON(NR) = IHOATAdtJ) 003026 

225 CONTINUE 003027 

100 on 230 L=1,NCN 003028 

IF dCON(L) .EO. 0) GO TO 230 003029 

IF dCONfL) .EO. 1» RID * ZRO 003030 

IF dCONIL) .EO. 2 ) RIL» = A0TCL,T| 003031 

230 CONTINUE 003032 
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DO 320 L*2,NH 003042 

LQ = 2*L - 2 003043 

LP = LO ♦ 1 003044 

NOBO = ITOPOLd,D 003045 

NOBP * 1 TOPOL 1 2, D 003046 

tH s 6*IL-1I 003047 

LBQ = LOCUINOBQ) - 1 003048 

LBP = LOCUINOBP) - 1 003049 

LEO = 6 + IPGFLXINOeO) 003050 

LEP = 6 ♦ IRGFLXINOBP) 003051 

DO 325 1=1,6 003052 

00 325 J=1,LEQ 003053 

325 PWd+LH,J+LBQ» = BH(I,J,LO> 003054 

DO 330 1=1,6 003055 

DO 330 J=1,LEP 003056 

330 9Wd+LH,J+LBP) = BHd,J,LP) 003057 

320 CONTINUE 003058 

003059 

DO 10 L=1,NCN 003060 

IF dCONILI .EQ. 0» GO TO 10 003061 

IF flFLAG .LT. 21 GO TO 400 003062 


150 DO 310 1=1,NCN 
00 310 J=1 ,NU 
310 BWd,J) = ZRO 

LEO = 6 ♦ IRGFLXm 
DO 315 1=1,6 
DO 315 J=1,LE0 
315 BWd,J) = eHCI,J,ll 
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JBIG = IVECIU 
A = DABS(BW(L«JBIG)I 
GO TO A^IO 
400 JBIG = 0 
A = ZRO 
DO 15 J=1,NU 

IF (JCON(J) .EQ. 0) ^0 TO 15 
AT = 0AB5(RW(L9J)) 

IF (AT .LT. A) GO TO 15 
A = AT 
JBIG - J 
15 CONTINUE 

IVECfU = JBIG 

410 IF (A .LE, EPS) GO TO 999 
F = BVMLvJBIG) 

DO 17 J-:i»NU 
17 BW(LfJ) = BW(L,JI/F 
RID = R(L)/F 
BW(LtJBIG) = ONE 
00 25 1=1, NCN 
IF (I -EQ. I .OR. ICONdl 
F = BWfI,JPIG) 

DO 30 J=1,NU 
30 BWII,J) = BW(I,J) - F*BM(L,J) 

RCn »r RID - F4RILI 
BWdrJBIGI = ZRO 
25 CONTINUE 
10 CONTINUE 

DO 35 L=l,rfCN 
lU = IVFCIL» 

IF (LU .EQ. 0) GO TO 35 
Y(LU) = ZRO 
35 CONTINUE 

00 40 L=1,NCN 

IF I ICON CL I .EQ. 01 GO TO 40 
DO 45 J=1,NU 

45 PCD = RCL> - RW(L,J)«Y(J) 

40 CONTINUE 

DO 50 L=1,NCN 
LU = IVECID 
IF (LU .EQ. 0) GO TO 50 
IF CIFLAG .EO. II INDEP(LUI = 0 
Y(LU) = RID 
50 CONTINUE 

RETURN 

999 WRITE (NOT, 1001 1 
1001 FORMAT C1H1,25HSINGULAR EQUATIONS, 
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EO. 0) GO TO 25 
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STOP 


C 


END 
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[HD6»P FIT -003116 

[FOR, IS FIT -003117 

COMPILFR I XH=1I*CE0UI¥=CMNI -003118 

SUBROUTINE FIT(N, ARRAY, SLOPE) 003119 

DOUBLE PRECISION Y,SUNY,SUM1Y,0L0G10, SLOPE, ARRAY! 100) -003120 

C 003121 

M=0 003122 

ISUM*0 003123 

ISQSUMsO 003124 

SUMY=O.DO 003125 

SUM1Y=0.D0 003126 

00 4 1=1 ,N 003127 

IFfARRAYfl ))1,4,2 003128 

1 Y=0L0G10(-ARRAY!I) ) 003129 

GO TO 3 003130 

2 Y=OL0G10!ARRAY(I)) 003131 

3 M=M+1 003132 

ISUMsISUM^I 003133 

1S0SUM=ISQSUM+I»1 003134 

SUMY=SUMY-t-Y 003135 

SUMIY=SUMIY+I*Y 003136 

4 CONTINUE 003137 

SLOPE* I M *S UP lY-I SUM* SUMY) / ( M* ISOSUM-I SUM*I SUM ) 003138 

RETURN 003139 

END 003140 
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tHDGvP FORNB 
I FOR* IS FORMB 

COMPILER «XM=l),IEOUIVsCMNJ 

SUBROUTINE FORMB (KR« KC* RLRT* CMPR* FBR* FBC) 

IMPLICIT DOUBLE PRECISIONU-M.O-Z) 

CFORMB FACTORED FORM TIME CONSTANTS* DAMPING AND FREQUENCY 

CALLING SEQUENCE FOR SUBROUTINE FORMB IS AS FOLLOWS 
CALL FORMB (KR* KC* RLRT, CMPR* FBR. FBC) 

KR — COUNT OF REAL ROOTS, MAY OR MAY NOT INCLUDE ZEROS'. 

KC — COUNT OF THF COMPLEX PAIRS OF ROOTS, 

RLRT — STORAGE BLOCK CONTAING ALL REAL ROOTS. 

CMPR — STORAGE BLOCK CONTAINING COMPLEX PAIRS OF ROOTS 
FBC — FORM B COMPLEX PAIR BLOCK lOUTPUT FROM ROUTINE) 

FBR — FORM B REAL ROOT BLOCK (OUTPUT FROM ROUTINE) 

DIMENSION RLRT(l)*CMPR(l),FBRn)*FBC(l) 

IF (KR) 140, 140* 100 
100 DO 130 L = 1*KR 

IF (RLRT(D) 120* 110, 120 
110 FBR(L) = 0.0 
GO TO 130 

120 FBR(L) = -l.DO/ RLRT(L) 

130 CONTINUE 

140 IF (KC) 170, 170* 150 
150 KK = 2*KC 

DO 160 L s 2*KK*2 

FBC(L) = DSQRT(CMPR(L-1)**2 ♦ CMPRID^’KZ) 

160 FBC(L-l) = -CMPRCL-1 )/FBC(L) 

170 RETURN 
END 
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[HDGtP GAUSSI 
tFORtlS GAUSSI 

COMPILER fXMsl)»(EOUIVsCNNl 
SUBROUTINE GAUSSI IAfR»N*KAR) 

IMPLICIT DOUBLE PRECISION I A-«tO-Z) 

DIMENSION ACKARtll. RfKAR«l)» IVECI150) 

COMMON /DRATIO/ 

• IFL1.IFL2,DRVECII50I 

C 

DATA EPS,NOT / l.D-06* 6/ 

1001 FORMAT f5X»30HMATRIX SINGULAR IN GAUSSI AT » 151 
C 

DO 5 1=1 ,N 
DO 7 J=lfN. 

7 R(1,J» = O.D 0 
5 R(Itl) = 1.0 0 
C 

00 10 L=1.N 
JBIG = 1 

A1 = DABSC Af L»in 
OO 15 J=2.N 
A2 = DABSfA(L,JM 
IF <A2 .LT, All GO TO 15 
A1 = A2 
JBIG = J 
15 CONTINUE 

IVECtLI = JBIG 
IF CAl .GT. EPS) GO TO 20 
IF (IFLl -EO. 0) GO TO 75 
IFL2 = 1 
GO TO 100 

75 WRITE fN0T,100II L 
STOP 

20 CONTINUE 

ALJ6IG = A(L*JBIG) 

DRVECCL) = ALJPIG 
00 17 J=1,N 
A(L»J) = A(L«J)/ALJ6IG 
17 RIL,J) » RfL.JI/ALJBIG 
DO 25 1=1, N 
AIJBIG = AfI,jeiG) 

IF fl .EQ. L) GO TO 25 
00 30 J=1,N 

A(I,J) = A(I,J) ~ AIJ6IG’»A(L,J) 

30 R(1,J) = Rtl.JI - AIJBIG*R<L,J) 

25 CONTINUE 
10 CONTINUE 
C 

DO AO 1=1, N 
IR = IVECIll 
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OO 40 J=1»N 
40 AlIRt Jl RfItJ) 

DO 50 I=1*N 
DO 50 J=1,N 
50 RdtJI = AfIvJI 
SN = l.ODO 
DO 110 L = ItN 
00 120 J = 1,N 
IPIIVEC(J> .EO. L» GO TO 110 
IFCIVECCJ) .GT. LI SN = -SM 
120 CONTINUE 
110 CONTINUE 

DRVECm = SN*ORVECm 

100 IFLl = 0 
RETURN 
END 
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CHDG»P GETBMB 
tFOR.IS GETBMB 

COMPILER ( XM=l|,(EQUIVsCMN) 

SUBROUTINE GETBMB 

IMPLICIT DOUBLE PRECISI0NlA-H,O-2) 

C 

COMMON /AMUBW / 

♦ AMU(15tl5» 5l»BW(30t 65) 

COMMON /BHBSRD/ 

♦ BH(6»l?t 9)«BSf6»l?»I0)tR0U3»3t 5)*00L(3» 5) 

COMMON /IVCONS/ 

♦ IV(6f 5) 

COMMON /MAXMUM/ 

♦ NBMAX.,NHMAXtNSPMAXtNMWMAX,NMWBOO,NMOBOD,KMUtKY,KU 

COMMON /NUMBRS/ 

♦ ZRO,ONE,TWOfTRES 

COMMON /SPECIF/ 

♦ BETAH(6, 5)tBFTAHD(6f 5)tAMO(2t 5 ) tRHI 3f 3*24) »RS f 3,3 ,20 » , 

♦ 0HI3,28 ),0S(3,20»,IM0C3, 5»,NMOWI5, 5) ,IFTSMW<10I , 

♦ NB,NH,NSPT,NOFMO,NOELTA,ITCPOLC2, 5),IRGFLX( 5),IH0ATAI7, 

♦ LOCU( 12),LENUn2lW^U,NBETA,NLAM,NE0 
C 

DIMENSION BM6(30,30) ,BMt6,I5, 9), ITOPf 5, 5),WR(I2) 
EQUIVALENCE (6W( 1 ) ,BMB( 1 ) ) , (BW( 9ni),BM(l)) 

C 

DATA IlST / 0 / 

C 

IF (IIST ,E0- 1) GO TO 100 
IlST = 1 
DO 5 1=1, NH 
DO 5 J=1,NB 
5 ITOP|I,J) = 0 
IT0P(1,1) = I 
00 3 1=1,6 
00 3 J=1,NH 
3 ivn,vi) = 0 
IC = 0 
00 7 J=1,NH 
DO 7 1=1,6 
IPl = I + 1 

IF (IHnATA(IPl,J) .EO. 01 GO TO 7 
IC = IC ♦ 1 
IVII,J) = IC 
7 CONTINUE 
DO 10 L=2,NH 
LO = 2*L - 2 
LP = LO ♦ 1 
NO 1T0PCL(1,L) 

NP = IT0P0L!2,L) 

ITOP(L,NOI = LC 
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10 IT0PfL,NPI = LP 
C 

100 LEO = 6 ♦ IRGFLX<n 
LMO = LENU(l) 

CALL MLTSR <BH»AMU«BH»LEQ,LHQfl»IV«KMU) 

C \ 

DO 20 Ls2fNH 
NOBO - IT0P0L(1,LI 
NOBP = IT0«»0U2,L) 

LEO = IRGFLX(NOBQ) ♦ 6 
LEP = IRGFLX(NOBP) ♦ 6 

LMO = LENUfNOBQ) / 

LMP = LENU(NOBP) ^ 

LQ = 2*L - 2 
LP = LO ♦ 1 

CALL MLTSR fBH(l«l»LO)tAMU(ltl«N060)tBM(l»l«LQ)fLEQ»LMQ«L«IV»KMU} 
CALL ULTSR f BH(1,1 ,LP ) t AMUd, 1 »NOBP) »BM (1 ,1»LP) tLEP,LNP,L» IV,KMU) 
20 CONTINUE 
C 

DO 25 I=1,NLAM 
00 25 Jsl»NLAM 
25 BNB(ItJ) = ZRO 
C 

DO 30 N=1,NB 

LE - IRGFLXfN) ♦ 6 

DO 35 L=lfNH 

IP IITOPIL.N) .EO. 0) GO TO 35 
DO 40 I=LtNH 

IF (ITQPlI.Nr .EQ. 0» GO TO 40 
LBM = ITOPIL,N) 

LBT = ITOP n,N> 

DO 50 M=l,6 ' 

ML = 1V(M,L» 

IF (ML .EO. 01 GO TO 50 
DO 55 K=1,LE 
55 MRCK) = BM(M,XfLBM» 

DO 60 J=l,6 
JI = IVCJtll 

IF (JI .IT. MU GO TO 60 
S = ZRO 
DO 65 K=1,LE 

65 S = S ♦ WR (K )*BH(J*KtLBT) 

BMB(ML*JI) - BMB(HLtJI) ♦ S 
60 CONTINUE 
50 CONTINUE 
40 CONTINUE 
35 CONTINUE 
30 CONTINUE 
C 

RETURN 
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[HDG,P GHISC 
tFOR.IS GHISC 

COMPILER ( XM=l)f IEOUIV=CMN» 

SUBROUTINE GMISC (NfLEtL0tV2) 

IMPLICIT DOUBLE PRECISION fA-H,0-Z» 

DIMENSION V2(l) 

C 

COMMON /MAXH/JM/ 

* NBMAX tNHHAXtNSPMAXyNHWMAXfNMWBODtNMDBOD«KHUtKY,KU 

COMMON /SPECIF/ 

* BETAHf6t 5)yBETAHD(6» B)«AM0f2y 5) tRH<3»B«24) »RS ( 3,3 y 20 ) , 

* 0Hf3y?8)yDS(3y2O)yIM0t3y 5l,NMOWf5, 5) ylFTSMMMO) y 

* NByNH,NSPTyN0FM0yNDELTA,IT0P0LI2y 5»,IRGFLX( 5),IHDATA(7y 

* LOCU( T2)yLENU(12)yNU,NBETA,NLAM,NE0 

COMMON /VECTOR/ 

* Y(250 l,YDT(250) 

C 

DATA IlST / 0 / 

C 

CCC USER SUPPLIED SUBROUTINE TO CREAT MISC. CONTRIBUTIONS TO R.H.S 
CCC INCLUDING THE THERMAL GRADIENT ENVIRONMENT. 

C 

IF HIST .FQ. 1) GO TO 5 
11 ST = I 
C 


5 CONTINUE 

LOMl = LO - 1 
DO 10 T*lyLE 

10 V2III = YlLOMl + I) - 0.0 0 


RETURN 

END 
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fHDG,P GRVGRO 
(FOR, IS GRVGRD 

COMPILFR (XM=1|,(EQUIV=CHN» 

SUBROUTINE GRVGRD (GGV) 

IMPLICIT DOUBLE PRECISI0N(A-H,0-Z) 

DIMENSION GGVdl 
C 

COMMON /AMUBW / 

♦ AMU(lfi,15, 5»,BWI30, 65) 

COMMON /BHBSRO/ 

♦ BH(6,12, 9),BS(6,12,10),R0L(3,3, 5),OOL(3, 5) 

COMMON /GGOATA/ 

♦ GAMGH3),GMA6,RCMAG 

COMMON /GGSAVE/ 

♦ GGS( 6,9, 5) , 

COMMON /INTGRL/ S, 

♦ AMI 79, 5),ACOF|9, 6, 5),6COF(6, 6, 5), 

♦ COFll ( 6, 6, 5),C.OF22( 6, 6, 5),COF33( 6, 6, 5),AK( 6« 6, 5), 

♦ C0F12I 6, 6, 5),COF13( 6, 6, 5),COF23l 6, 6, 5), ADC 6, 6, 5), 

♦ COFXYC 6, 6, EltCOFXZC 6, 6, 5»,COFY2( 6, 6, 5) 

COMMON /MAXMUM/ 

♦ NBMAX ,NHMAX,NSPMAX,NMWMAX,NMHBOD,NMDBOD,KMU,KY,KU 

COMMON /NUM9RS/ 

♦ ZRO,ONE,TWO,TRES 

COMMON /SPECIF/ 

» BETAHI6, 5),BETAH0(6, 5),AMOC2, 5) ,RH(3, 3,24) ,RS 13,3,20) , 

♦ DH(3,28 ),DSC3,20),IM0C3, 5),NM0WC5, 5) ,IFTSMMI 10) , 

♦ Ne,NH,NSPT,N0FM0,NDELTA,IT0P0LI2, 5),IPGFLXC 5),IH0ATA<7, 5), 

♦ LOCUC 12),LENUI12),MU,NBETA,NLAM,NE0 

COMMON /VECTOR/ 

♦ Y(25O),Y0TC250) 

C 

DIMENSION GAMGL(3),V(3) 

DATA NOT / 6/ 

C 

IF CGMAG .EQ. ZRO) RETURN 
r IF IRC MAG .LE. OVE ) GO TO 999 
DO 10 N=1,NB 
LOU V 10CUIN)V 
LO = LOCUC N+NP) 

LE = LENUCN+NB) 

CALL MULT3 IGAMGI ,R0LC1,1,N) ,GAMGL, 1,3,3, 1,3,1 ) 

CALL MULT3 C AMU C4,l ,N ) ,GAMGL,GGVCLOU ) ,3,3 ,1 ,KMU, 1 ,1 ) 

V. CALL MULT3 fAMU ,GAMGL ,V,3,3, 1 ,KHU, 1, 1 ) 

GGV CLOU ) - GMAG*CGGVCLOU ) 

♦ ♦ TRES*CGAMGLC2)*VC3) - GAMGU3)*VC2) l/RCMAG) 

GGVCLOU-^l) = GMAG*CGGVCL0U+1) 

♦ ♦ TRES*CGAMGLC3)*VC 1) - GAMGLC1)*VC3) )/RCMA6) 

GGVCLOU+2) = GMAG*CGGVCL0U+2) ^ 

♦ •*- TRFS»CGAMGLC1 )#VC2) - GAMGLC 2) *VC1 ) ) /RCMAG) 
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V(l) = AMUI3»5tN) 

V(2) - AMU(lf6fN) 

VC3) = AMUI2f4fN) 
s = ZRO 

GCM = -«MAG*AMU(44,NI 
GCR = -GMAG/RCMAGH 
LOP2 = LOU ♦ 2 
DO 20 I=lt3 

GGV(L0P2+I) = 6CM4GAMGLII) ♦ GCR*Vm 
20 ? = S ♦ GAMGLCI)*V(I» 

S » -TRES*S*GCR 
DO 25 1=1*3 

25 GGV(L0P2+I1 = GGV(L0P2+I) ♦ S«GAPGtm 
IF CLE .EQ. 0) GO TO 10 
LCP6 = LOU ♦ 6 
V(l) = GAMGLm*RCMAG 
V«2) = GAMGL(2)*oCMAG 
V(3» = GAPGL (3)*RCMAG 

CALL MULT? I V,AHU 14 *7tNI ,GGV ( L0P6) ,1 *3 ,LE ,1 *KMU, 1 I 
CALL MULTAD 1 AMU (7 ,7 ,N I ,Y f LO) ,GGVf L0P6 1 ,LE,LF,1 ,KMU,1 , 1) 

L0P5 = LOU + 5 
DO 30 J=1,LE 

GGV1L0P5+J1 = GCR*GGV(L0P5+J 1 

* -» GCR*(BCnF(l,J,N) + BC0FI2*J*N) ♦ BC0F13,J,Nn/TH0 
30 CONTINUE 

C 

VI 1) = ONE - TWO*GAMGL(ll*GAMGLin 
VI 2 ) = ONE - TW0*GAMGL(2)*GAMGL(2) 

VI 3) = ONE - TW0*GAMGL(3)*GAMGL13) 

S = TRES»GMAG/(TWO*RCMAG> 

C 

DO ’40 J=1,LE 

GGVCL0«*5+J) = GGV1L0P5+J) 

* + S* (VC D^lBCOFIl ,J,N» GGSUtltNl) 

* + V( 2)*(BC0F(2»J,N) ♦ GGf(J*2tNn 

* V( 3»>MBC0F(3»J*N» ♦ GGSIJ*3*Nn 

* TWn*GAHGL (1I«GAMGL(2)*(BC0F(4*J,N) GGS(J*4,N) * GGS(J*7»N|} 

* + TW0*GAMGLm*GAMGL(3l*(BC0Ff5,J*N) ♦ GGS(J* 5 »N) GGS(J»8*N)) 

* TW0*GAMGL(2l*GAMGL(3)4(BC0Fl6,JtN) * GGS(J*6*N) GGS 1 J *9*N )) 1 

40 CONTINUE 

C 

10 CONTINUE 
RE TURN 
C 

999 WRITE (NOT, 2001 J 

2001 FORMAT ( IH 1 , 29HRCMAG = 0., SUBROUTINE GRVGRD) 

STOP 

END 
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(HOGtP INVINP 
[FOR, IS INVINP 

COMPILER tXMsl)»IECUlVs:CHN) 

SUBROUTINE INVINP (A«R»N«KA) 

IMPLICIT DOUBLE PRECISION! A~H *0-2 1 

*«**4a»:^** 

MATRIX A MUST BE SYMMETRICt MAX N = XX 

«***•***** 

DIMENSION AfKA«l)»R!KA«l)»CL( li). 

C 

DATA EPS»NOT / l.D-06f 6/ 

C 

L = 1 

IF CA(1,1» -LT. EPS) GO TO 999 
C 

R!l,l) = 1 .D+OO/Af 1,1) 

DO 100 L = 2,N 
N1 = L - 1 
DO 10 I-1,NI 
CL Cl) = 0.0+00 
DO 10 J=1,N1 

10 CL(I) = CL<n ♦ RII,J)*AfJ,L) 

S > A(L,L) 

DO 20 1=1, N1 
20 S = S - A(I,L)*CL(I) 

IF (DABS(S) ,LT, EPS) 60 TO 999 

S = 1.0+00/S 

no 30 1=1, K1 

V = -s*CLm 

R(I,L) = V 

R(L,I) = R(I,L) 

DO 30 J=I,N1 

RC1,J) = PfI,J) - V*CL(J) 

30 R(J,I) = R II,J) 

R(L,L) = S 
100 CONTINUE 
C 

RETURN 

C 

999 WRITE(NDT,«H>0) L 

900 FORMAT!/, 5X,32HSINGULAR MATRIX IN INVINP AT L =,I5,9H STOP RUN) 
STOP 
C 

END 
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[HOG.P KHINGE 
[FOR, IS KHINGE 

COMPILER CXH=1|, IEOUIV=CMN) 

SUBROUTINE KHINGE IG) 

IMPLICIT DOUBLE PRECISION <A-HtO-Z» 

DIMENSION GIIJ 

DIMENSION SK(3,6l»DK(3*6)«HNGTf3»6) 

C 

COMMON /BHESRD/ 

♦ BH(6»12t 9) «B5(6fl2*10ltROL(3»3» 5I«D0LI3. 5) 

COMMON /CONPAR/ 

♦ CNTDTAIlOO) 

COMMON /MAXMUM/ 

♦ NRMAX ,NHMAX,NSPMAX,NMWMAX,NMWBnD,NMOBOO,KMU»KYtKU 

COMMON /MOMENG/ 

♦ P( 65 ),PMOM(30),HTOTI3»,TOTLI3)fENGKEI 5)«ENGPE( 51 t 

♦ TOTKF, TOTPEt TOTENG, AHTOT.ATOTL 

COMMON /SPECIF/ 

♦ BETAHC6, 5I,eETAHr(6, 5)tAMO(2t 5 ) ,RHC3,3 ,2A» ,RS (3 13 t20 ) , 

♦ DH(3«28),DSf3»20)tIM0(3,> 5)fNMOM(5t 5) t IFTSMWIlO ) » 

♦ NBtNH,NSPT,NOFMC*NOELTA»ITOPOLf2f 5)»1RGFLX( 5JtIH0ATAI7, 

♦ LOCUC 12J*LENUn2),NUfNBETA,NLAM»NEO 
C 

EQUIVALENCE CCNTOTAC 12 ) tSK( 1 I) r ICNTOTA (30S ,DK (1 H 
C 

TOTPE = 0.00 
C 

DO 10 L=lfNH 
DO 10 1=1,3 

HNGT(I,LI = -ISKflfLl^EETAHCI.L) + 0K( I ,L)*BETAHOII,LII 
10 TOTPE = TOTPE + 0.5D0»SK CI,L>»BETAHn,L l**2 
C 

LEQ = IRGFLXCl) ♦ 6 
DC 15 1=1,3 
F = HNGTII,l» 

DO 16 J=1,LEC 

16 GCJ) = G(J) ♦ F*BHCI,J,il 
15 CONTINUE 
C 

DO 20 L=2.,NH 
NOBQ = 1T0P0L(1,L1 
NOPP = ITOPOL(2,L) 

LQ = 2*L - ? 

LP = LQ ♦ 1 

LOQ = LOCUCNOBQl - 1 

LOP = LOCU(NCBP) - 1 

LEO = IRGFLX(N0B01 + 6 

LEP = IRGFLXfNDBP) + 6 

DO 20 1=1,3 

F = HNGT(I,L) 
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DO 25 J=ltLFG 003566 

lOOJ = LOO ♦ J 003567 

25 GILOQJII s G(LOQJ) * F«BH( I » J»LO!/ 003568 

on 26 J-ltLEP 003569 

LOPJ = LOP + J 003570 

26 GiLOPJI = G(LOPJ) ♦ F*6H(I»J»LP) 003571 

' 20 CONTINUE 003572 

C 003573 

RETURN 003574 

END 003575 
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fHDGtf* LINEAR 
IFOR, IS LINEAR 

COHRILER ( XMsl)« fEOUIV=^CHN) 

SUBROUTINE LINEAR INRtNC) 

IMPLICIT OOllBLE PRECISION fA-H,0-Z» 

C 

C SUBROUTINE ESTABLISHES FIRST PARTIAL DERIVATIVES OF A YDOT 
C DESCRIBED FUNCTIONAL AT AN INITIAL STATE, Y, USING OUADRATIC 
C INTERPOLATION FUNCTIONS. 

C 

C THE PARTIAL DERIVATIVE MATRIX IS WRITTEN COLUMNWISE ON UNIT NU, 
C CALLS SUBROUTINE YDOT 

COMMON /PRWORK/ 

♦ PR(250,5I 
COMMON /TAPENO/ 

♦ NTAPE1,NTAPE2,NTAPE3 
COMMON /VECTOR/ 

♦ Y(250»,YOT<2?50I 
COMMON /VINOEP/ 

♦ INDEP 12501 

COMMON /LOSIZE/ NX,NY,N0LTA,NXSS,NB,NJQ,NY2,ND2 

SUBROUTINE ARGUMENT DESCRIPTIONS 

NR = INPUT NUMBER OF ROWS IN PARTIAL DERIVATIVE MATRIX. 

NC = INPUT NUMBER OF COLUMNS IN PARTIAL DERIVATIVE MATRIX. 

DIMENSION FYt250,3),Zf250),ZNEWf250),IV(250l 
EOUIVALENCF (PR ( 1) ,FY«1 )l , IPR I 751 »,Z (1 l» , (PR f 1001 » ,2NEW( 1 M 
EQUIVALENCE (INDEP (1 1 ,IV( 1 )) 

DATA NOT/ 6 / 

DATA PCON,PMIN/ l.D-02,l.D-05 / 

DATA EPS1.EPS2/ 1.0-10,1.0-04 / 

NU = NT A PE 2 

ESTABLISH OUTPUT SIZE OF PARTIAL DERIVATIVE MATRIX 

NJQ = 0 

NX = 0 

DO 5 I=1,NP 

IF (IV(I» .NE. 0» NJQ = NJCt+1 
IF (I .GT. NCI GO TO 5 
IP (IV(I) .NE. O) NX=NX+1 
5 CONTINUE 

REWIND NU 

00 20 1=1, NR 
20 FY(I,1| = YDTdl 
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003594 

2103595 

003596 

003597 

003598 

003599 

003600 

003601 

7803602 

7903603 

003604 

003605 

003606 

003607 

003608 

003609 

003610 

003611 

003612 

003613 

003614 

003615 

003616 

003617 

003618 

003619 

003620 

003621 

003622 

003623 

003624 

003625 
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c 



003626 



00 200 L=lfNC 

003627 



IF flVlL) ,FQ. 01 GO TO 200 

003628 



OY = PCON ♦ Y(L) 

003629 



IF (DY ,L,T. PMIN) OY s PMIN 

003630 

c 



003631 



YY = YIL) 

003632 



Y(L» = Y(L» ♦ OY 

003633 



CALL YOOT 

003634 



Y<LI = YY 

003635 

c 



003636 



00 30 1=1, NP 

003637 


30 

FY(I,3I = YOTCn 

003638 

c 


. 

003639 



YY = YCL) 

003640 



Y<L) = Y(LI ♦ 0.500 ♦ OY 

003641 



CALL YOOT 

003642 



YfU = YY 

003643 

c 



003644 



00 35 1=1, NR 

003645 


35 

FY(I,2) = YOTU) 

003646 

c 



003647 



00 50 1=1, NR 

003646 



El = -3.00 ♦ FYCI,1» ♦ 4^.00 ♦FYI1,2) - FYII,3) 

003649 



Zm = El / DY 

003650 



IF (DABSfZdM .LT. EPSl) Z(l» = 0.00 

003651 


50 

CONTINUE 

003652 



TTR = 0 

003653 


60 

DY = 0-500*0Y 

003654 

c 



003655 



DO 70 1=1, NR 

003656 


70 

FY(I,3) = FY(I,2I 

003657 

c 



003658 



YY = YfL) 

003650 



Y(L) = YIL) + 0.500 ♦ DY 

003660 



CALL YOOT 

003661 



YIL) = YY 

003662 

c 



003663 



DO 80 1=1, NR 

003664 


80 

FV|I,2) = YDTII) 

003665 

c 



003666 



00 90 1=1, NR 

003667 



El = -3.00 ♦ FYI1,1) + 4.00 ♦ FYfI,2) - FYII,3) 

003668 



2NEWII) = El/DY 

003669 



IF IDABSIZNEWII) ) .LT. EPSl) ZNEWII) = 0.00 

003670 


90 

CONTINUE 

003671 

c 



003672 



DO 100 1=1 ,NP 

003673 

c 



003674 



IF IIVII) .EO. 0) GO TO 100 

003675 


o o n n o n 
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ON = DABSIZfin 
DNl = OABSfZNEWfin 

IF (DNl ,GT. ON) ON = DNl 
IF (ON .LT. EPSl) GO TO 100 
G1 = DABS(ZNEW(T) - Z(l))/ ON 

IF (Gl .LE. EPS2) GO TO 100 

ITP = ITR ♦ I 

IF (ITR .GT, 301 GO TO 999 
DO 95 J=I,NR 
95 Z(J) = ZNEW(J) 

GO TO 60 
100 CONTINUE 

COMPLETION OF THE DO 100 LOOP INDICATES WE HAVE ACCEPTED 
ZNEW(I) ,T=1,NR» 

NOW PACK PARTIAL DERIVATIVES INTO A NJO LONG VECTOR. 

J=0 

DO 110 1=1, NR 
IF (IV(I) .EQ.O) GO TO 110 
J=J*1 

ZNEW(J) = ZNEW(I) 

110 CONTINUE 
C 

WRITE (NU) (ZNEW(J),J=1,NJ0) 

C 

200 CONTINUE 
RETURN 
C 

999 WRITE (NOT, 2001) I ,L ,DY,Z ( I ) ,ZNEW( I ) 

2001 FORMAT ( IH 1, ////,20X , 

♦ 36HSUBR0UTINE LINEAR FAILED TO CONVERGE ,/,20X, 

* 28HIN 30 ITERATIONS ON ELEMENT ,/,10X, 

♦4HI = ,I3,/,10X, 

♦AHJ = ,I3,/,10X,19HLAST Y INCREMENT = ,012.4,//,10X, 

*7HZ = 01?.6,/,10X, 

♦7HZNEW = D12.6^) 

C 

STOP 

END 


003676 

003677 

00367/8 

003679 

003680 

003681 

003682 

003683 

003684 

003685 

003686 

003687 

003688 

003689 

003690 

003691 

003692 

003693 

003694 

003695 

003696 

003697 

003698 

003699 

003700 

003701 

003702 

003703 

003704 

003705 

003706 

003707 

003708 

003709 

003710 

003711 

003712 

003713 

003714 

003715 

003716 

003717 

003718 

003719 

003720 
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tHDG«f> LPLTWR 
t FOP, IS LPLTWP 

COMPILER (XM^ntfEOUIVsCMN} 

SUBROUTINE LPLTWR 

IMPLICIT DOUBLE PRECISI0NCA~H,0“ZJ 
SUBROUTINE WRITES TAPE NUTS FOR PLOTTING. 
COMMON /LDSIZE/ 


2 

NX, 

NY, NOLTA, 

NXSS, NB, NJO, NY2, ND2 

COMMON 

/TAPE NO/ 




4 

NUTl 

• NUT2 

t NUT3 

COMMON 

/VECTOR/ 




E 

Y 

(250), 

YD 

(250) 

COMMON 

/TIMESS/ 




G 

ST, 

o 

H 

ET, 

TMST 

COMMON 

/PLTDTA/ 





1 NR PLOT ,NC PLOT 

DATA I 1ST / 0 / 

IF CIIST .NE. 0) 60 TO 5 
II ST = 1 
REWIND NUTS 
NRPLOT = O 
NCPLOT = 2*NX + 1 
5 NRPLOT = NRPLOT ♦ I 

WRITE CNUT3) T, (YD( I ) ,1 = 1 ,NX) , (Ym,Isl ,NX ) 
C 

RETURN 

END 


-003721 

-003722 

-003723 

003724 

-003725 

003726 

003727 

003728 

003729 

003730 

003731 

003732 

003733 

43003734 

003735 

003736 

003737 

003738 

003739 

003740 

003741 

003742 

003743 

003744 

003745 

003746 

003747 

003748 

003749 
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tHDG*P LPRNT 
t FOR, IS LPPNT 

COMPILER (XH=l),iEOUIV=CMN> 

SUBROUTINE LPRNT 

IMPLICIT DOUBLE PRECIS ION (A-M,0-Z) 

SUBROUTINE PRINTS OUT RESULTS OF LINEARIZED TIME RESPONSE. 
COMMON /VECTOR/ 

E Y (2501, YD (250) 

COMMON /LOSIZE/ NX,NY,N0LTA,NXSS,NB,NJ(J,NY2,ND2 
COMMON /TIHESS/ 

G ST, OT, T, ET, TMST 

DATA NOT/ 6 / 
data IlST/ 0 / 

IF (IlST ,NE. 0) GO TO 5 
IlST = 1 

PRINT OUT DATA AT START. 

CALL PAGEHD 
WRITE (NOT,ll) 

11 FORMAT (////30X,2AHLINEARIZE0 TIME RESPONSE / 

* 32X,2AH GENERAL INFORMATION //) 

WRITE (NOT, 12) ST,OT,ET 

I? FORMAT (//30X,26H1NTEGRATI0N PARAMETERS ARE // 

* 30X,13HSTART TIME = D12.5,/, 

* 30X,13HDELTA time = D12.5,/, 

* 30X,13HEN0 TIME = 012.5) 

LY = 1 
LX = LY+NY2 
LO=LX+NXSS 
LB=LD+ND2 

5 CONTINUE 
CALL PAGEHD 
WRITE (NOT, 101) T 

101 FORMAT (/5X,1BHSIMULATI0N TIME = D12.5) 

WRITE (NOT, 102) NY2,NXSS,ND2,NB 

102 FORMAT (/30X ,30HNUMPER OF PLANT VARIABLES = 15, 

* /30X,30HNUMBER OF SENSOR SIGNALS = 15, 

* /30X,30HNUMBER OF CONTROL VARIABLES = 15, 

* /30X,30HNUMBER OF CONTROL TORQUES =15) 

WRITE (NOT, 103) 

103 FORMAT ( //?0X,29HSTATE VECTOR TIME DERIVATIVES /) 

CALL WRITES (YD,1,NX,1) 
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-003751 

-003752 

003753 

-003754 

003755 

003756 

003757 

003758 

43003759 

003760 

003761 

003762 

003763 

003764 

003765 

003766 

003767 

003768 

003769 

003770 

003771 

003772 

003773 

003774 

003775 

003776 

003777 

003778 

003779 

003780 

003781 

003782 

003783 

003784 

003785 

003786 

003787 

003788 

003789 

003790 

003791 

003792 

003793 

003794 

003795 

003796 

003797 

003798 

003799 
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] 


C 003800 

WRITE tN0T*1041 003801 

104 FORMAT |/20X,12HSTATE VECTOR /) 003802 

CALL WRITES (Y »l«NXtl) 003803 

C 003604 

WRITE f NOT, 105 I 003805 

105 FORMAT I/20X ,20HPLANT VARIABLE RATES ) 003806 

CALL WRITES (YD,1,NY2,1) 003807 

C 003808 

WRITE f NOT, 106) 003809 

106 FORMAT C// 20X,19HSENS0R SIGNAL RATES) 003810 

CALL WRITES (YDf LX),1,NXSS,1) 003811 

C 003812 

WRITE f NOT, 107) 003813 

107 FORMAT ( //?OX,22HCONTROL VARIABLE RATES) 003814 

CALL WRITES (YDf LD ), 1 ,N02,1 ) 003815 

C 003816 

WRITE (NOT, 108) 003817 

108 FORMAT (//?0X,19HT0RQUE SYSTEM RATES) 003818 

CALL WRITES (YD(LB ),1,NB,1) 003819 

C 003820 

WRITE (NOT ,109) 003821 

109 FORMAT (///20X,20HPLANT VARIABLE STATE) 003822 

CALL WRITES (Y,1,NV2,1) 003823 

C 003824 

WRITE (NOT, 110) 003825 

110 FORMAT (//20X,19HSENSOR SIGNAL STATE) 003826 

CALL WRITES (Y(LX) ,1 ,NXSS ,1 ) 003827 

r nA9fl9A 

WRITE (NOT,) 11) 003829 

111 FORMAT (//2OX,22HC0NTR0L VARIABLE STATE) 003830 

CALL WRITES (Y(LD) ,1 ,ND2,1 ) 003831 

C 003832 

WRITE (NOT, 112) 003833 

112 FORMAT (//20X,19HT0RQUE SYSTEM STATE) 003834 

CALL WRITES ( Y(LB ) ,1 ,NB ,1 ) 003635 

C 003836 

RETURN 003837 

END 003838 


1 

1 


] 
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tHOG.P LTPROL 
t FOR, IS LTORQL 

COMPILER {XH=l),IEOUIV=CMNJ 
SUBROUTINE LTORQL (VTDRQ) 

IMPLICIT DOUBLE PREC IS10N(A-fl,0~ZI 
C 

DIMENSION VTORQCll 


COMMON 

/KOSIZE/ 




1 

KR, 

KRT, KRXt 

KVl, KV2, 

COMMON 

/VECTOR/ 




E 

Y 

(250), 

YO 

(250) 

COMMON 

/TIMESS/ 




G 

ST, 

OT, T, 

ET, 

TMST 


C 

DATA I? ST/0/ 

C 

TLMT = 10.DO*DT 
IF (IlST .NE. 0) GO TO 10 
IF (T .GT. TLMT) IlST = 1 
CALL ZERO (VT0RQ,1,KVX,1) 
VTCR0C3A) = 1.00 
VTOROOS) = l.DO 
RETURN 
10 CONTINUE 

CALL ZERO fVTORO,l,KVX,l) 

RETURN 

END 


-003839 

-003840 

-003841 

003842 

-003843 

003844 

003845 

003846 

KVX 003847 

003848 

43003849 

003850 

003851 

003852 

003853 

003854 

003855 

003856 

003857 

003858 

003859 

003860 

003861 

003862 

003363 

003864 

003865 


1 
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[HDGfP LTRESP 
r FOR* IS LTRESP 

COMPILER f XM=n,(E0UIV=CMNI 
SUBROUTINE LTRESP 

IMPLICIT DOUBLE PREC IS ION I A-H ,0-ZI 

SUBROUTINE SOLVES FOR THE LINEARIZED TIME RESPONSE. 
TECHNIQUE USES A RUNGE KUTTA STARTER AND AN ADAMS CORRECTOR 
RECURRSIVF FORMULA FOR THE TIME SOLUTION. 

COMMON /KDSIZF/ 


C 

C 


ASSUMES THAT HI - A* ON ENTRY. 

UNIT NUT3 WILL BE WRITTEN FOR PLOTTING 

DIMENSION PRKU), YDSC250*3)* YSf250» 

STORE Y* IN YS, THEN ZERO Y. 

DC 20 I=1*NX 
YSdl = Y( I) 

20 Y(II = 0.00 
PRK(l) = O.'JDO 
PRK(2) = l.DO - OS0RTCO.5DO) 

PRKI3) = 1.00 ♦ DSCRTfO.SDO) 

PRK(A) = 0.500 

NT = 0 
T = ST 
TMST = 0.00 
IPRNT = 0 
IPLOT = 0 

REWIND NUT3 

WRITE INUT3) ( (Win* J),l=l*KRJ*Jl'-l,KR) 


-003066 

-003867 

-003868 

003869 

-003870 

003871 

003872 

003873 

003874 

003875 

003876 


1 

KR, 

KRT, KRX, KVl, KV2, KVX 

003877 


/LDSTZF/ 


003878 

i 

NXf 

NY* NDLTA* NXSS* NB* NJO* NY2* ND2 

003879 

COMMON 

/TAPENO/ 


003880 

A- 

NUTl 

* NUT2* NUT3 

003881 

COMMON 

/MISCNO/ 


003882 

5 

NOPRNTt NOPLCT 

003883 

COMMON 

/ LVl / 


003884 

C 

VI 

( 50), V2 1 50), V3 ( 50) 

42603885 

COMMON 

/VECTOR/ 


003886 

E 

Y 

(250), YD (250) 

43003887 

COMMON 

/LWORKl/ 


003888 

F 

Wl( 

50, 50), W2( 50, 50) 

43203889 

COMMON 

/TIMESS/ 


003890 

G 

ST, 

DT, T, ET, TMST 

003891 


003892 

003893 

003894 

003895 

47003896 

003897 

003898 

003899 

003900 

003901 

00390? 

003903 

003904 

003905 

003906 

003907 

003908 

003909 

003910 

003911 

003912 

003913 

003914 

003915 


u u 
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REWIND NUT3 
C 

CON = 3.00 ♦ OT/8.00 
C 

DO 30 1 = 1* NX 

DO 30 J=1VNX 

Wlfl.J) = ~C0N*W1(1, Jl 

IF (J .EO. I) Wlfl.J) = l.-t^Wlfl.J) 

30 CONTINUE 
C 

CALI. GAUSSI (Wl*W2tNX«KR) 

READ CNUT3) t f Wl f 1 *J ) « 1=1 *KR 1 * J=l«KR ) 

REWIND NUT3 
C 

CALL ZERO fVl.ltNXtl) 

CALL LTORQL fV2) 

CALL YDOTL IW1,V2,Y,Y0,NX,KR) 

C 

DO 10 1=1, NX 
10 YOSfl.l) = YDCI) 

C USE THE R-K S TARTER - 
CALL LPRNT 
CALL LPLTWR 
C 

100 CONTINUE 

DO 120 J=1*A^ 

JIL = J 

00 110 1=1, NX 

Z = YDCI) 4 DT 

GO TO (103,101,101 ,105), JIL 

101 R = PRK(JIL) ♦ fZ-Vlfll) 

GO TO 107 

103 R = PRK(JIL) * Z - VKI) 

GO TO 107 

105 R = (Z-2.00 ♦ Vlfin / 6. DO 
107 Y(I) = Yfl) ♦ R 

110 VKI) = VKI) ♦ 3.00 ♦ R - PRK(JIL) ♦ Z 

IF (JIL .Et). 1 .OR. JIL .EQ. 3) T = T+ OT/2.00 
CALL LTOROL (V2) 

120 CALL YDOTL (Wl ,V2,Y,YD,NX,KR) 


NT = NT + 1 
ANT = NT 
TMST = ANT ♦ DT 
T = ST ♦ TMST 
C 

IPRNT = IPPNT + 1 

IF (IPRNT .NE. NOPRNT) GO TO 130 

CALL LPRNT 


003916 

003917 

003916 

003919 

003920 

003921 

003922 

003923 

003924 

003925 

003926 

003927 

003928 

003929 

003930 

003931 

003932 

003933 

003934 

003935 

003936 

003937 

003938 

003939 

003940 

003941 

003942 

003943 

003944 

003945 

003946 

003947 

003948 

003949 

003950 

003951 

003952 

003953 

003954 

003955 

003956 

003957 

003958 

003959 

003960 

003961 

003962 

003963 

003964 

003965 


ono non nnoo non 


i 


105 


IPRNT = 0 


003966 

130 CONTINUE 


003967 

IP LOT = IP LOT ♦ 1 


003968 

IF flPLOT .NE. NOPLOT) GO TO 140 


003969 

CALL LPLTWR 


003970 

IPLOT = 0 


003971 

140 CONTINUE 


003972 

00 150 I-1,NX 


003973 

150 Y0S.<ItNT+n = VOID 


003974 

IF IT .LE. ET .AND. NT .LT. 2) 

60 TO 100 

003975 

003976 

THE ADAMS CORRECTOR FORMULA 


003977 

003978 

CO = OT / 24.00 


003979 

Cl = CO ♦ o.oo 


003980 

C2 = CO ♦ 19.00 


003981 

C3 = -CO ♦ 5.00 


003982 

C4 = CO 


003983 

003984 

003985 

ESTABLISH Y AT STEP NT 


003986 

003987 

200 CALL LTOPQL -!V1) 


003988 

003989 

VI IS EXTERNAL FORCING FUNCTION FOR 

THE LINEAR SYSTEM. 

003990 

003991 

DO 210 I=ltNX 


003992 

210 Vm = Yll) ♦Cl*Vim ♦ C24Y0SI1 

,3) ♦ C3*Y0SCI,2) ♦ C4*YDS(I,n 

003993 

CALL MUL7B (W2»Y«NX,NX«1»KR,KR) 


003994 

003995 

RESET YDS FOR NEXT STEP. 


003996 
003 9P7 

DO 220 I = ltNX 


003998 

YDSCItl) = YDSI1,2) 


003999 

220 Y0Sflt2» = YDS(I,3) 


004000 

004001 

COMPUTE YO AT STEP NT. 


004002 

CALL YDOTL 1 Wi ,V1 ♦ Y, YD tNX t KR) 


004003 

004004 

DO 225 1=1, NX 


004005 

225 YDSC1,2) = YOU) 


004006 

004007 

NT = NT ♦ 1 


004008 

ANT = NT 


004009 

TMST = ANT * DT 


004010 

T = ST ♦ TMST 


004011 

004012 

IPPNT = IPONT ♦ 1 


004013 

IF (IPRNT .NE. NOPRNT) GO TO 230 


004014 

CALL LPRNT 


004015 


1 1 
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IPRNT = 0 

004016 


230 

CONTINUE 

004017 



IPLOT s IPLOT + 1 

004018 



IF C IPLOT .NE. NOPLOT J GO TO 240 

004019 



CALL LPLTWR 

004020 



IPLOT = 0 

004021 


240 

CONTINUE 

004022 

c 



004023 



IF CT .LT. ET) GO TO 200 

004024 

c 



004025 

c 



004026 

c 



004027 



RETURN 

004028 



END 

004029 
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[HDG»P MGFN 
tFORLflS MGFN 

COMPILER ( XK'Dt (FQUIV=CMN) 

SUBROUTINE MGFN 

IMPLICIT DOUBLE PRFC ISION f A-H tO-Z J 
C 

COMMON /AMUBW / 

♦ A«U(15,15, 5),BWI30, 651 

COMMON /BHBSRD/ 

♦ EHI6, 12, 9i,BS(6,l?,10),R0L(3,3, 5),D0LI3, 51 

COMMON /GGSAVE/ 

♦ GGSI 6,9, 51 

COMMON /INTGRL/ 

♦ AMI 7.8, 5>,AC0F(9, 6, 5»,BC0F(6, 6, 5), 

♦ COFll f 6, 6, 5),COF22f 6, 6, 5),COF33f 6, 6, 5»,AKf 6, 6, 51, 

♦ C0F12I 6, 6, 5),C0F13( 6, 6, 5»,C0F23( 6, 6, 5),A0( 6, 6, 5), 

♦ COFXYI 6, 6, 5),C0FXZI 6, 6, 5>,CCFYZ( 6, 6, 5} 

COMMON /MAXMUH/ 

♦ NBMAX ,NHMAX,NSPMAX,NMWMAX,NMWBOO,NMDBOD,KMU,KY,KU 

COMMON /NUMBRS/ 

♦ ZRO,ONE,TWO,TRES 

COMMON /SPECIF/ 

♦ BETAHI6, 5»,BFTaH 0C6, 5),AMO(2, 5 ) ,RH( 3,3,24 ) ,RSf 3,3 ,20 I , 

» DHC3,2F),0SI3,20I,IM0I3, 5),NMOW(5, 5 ) , IFTSMWI 10} , 

♦ NB,NH,NSPT,NOFMO,NDELTA,1TOPOLI2, 5},IRGFLXf 5I,1HDATAI7, 51, 

♦ LCCUl 121 ,LENU (12 ) ,NU ,NBETA,NLAM ,NEO 

COMMON /VECTOR/ 

♦ Y(250I,YDTI250) 

C 

DIMENSION RWI3, 6I,CW( 6,3) ,VWI9) ,WVI6) 

C 

KM = NMOBOD 
DO 10 N=1,NE 
LC = LC'CUINB+N) 

LE = LENUINB+N) 

KNT = 0 
NP6 = 6 + LE 
DO 12 1=1, NP6 
DO 12 J=I,NP6 
KNT = KNT ♦ 1 
12 AMU(I,J,N) = AM|KNT,N) 

IF ILF .FO. 0) GO TO 50 

CALL MULT3 IBCOF I 1 , 1 ,N ) ,Y( LO) ,VW ,6,LE , 1 ,6, 1 ,1 ) 

CALL MULT3 (COFll (1 ,1 ,N) ,Y (LO ) ,CW( 1 ,1 ) ,LE,LE, 1 ,KM ,1,KM) 

CALL MULT3 (CCF22 ( 1 ,1 ,N ) , Y ( LC ) ,CW ( 1 ,2 ) ,LE,LE ,1 ,KM, 1,KM ) 

CALL MULT3 (C0F33(1 ,1 ,N) •Y(L0),CW(1,3) ,LE,LE,1,KM,1,KM) 

CALL MULT3 ( Y(LO) ,C0F12 ( 1 , I,N ) ,RW ( 1 , 1 ) ,1 ,LE,LE, 1 ,KM,3 ) 

CALL MULT3 ( Y(LG ) ,C0F13( I, I,N ) ,RW(2 , 1 ) ,I,LF ,LF , 1 ,KM,3 ) 

CALL MULT3 (Y(LO) ,C0F23( 1,1,N),RN(3,1 ) ,1,LE,LE,1 ,KM,3) 

C 


-004030 

-004031 

-004032 

004033 

-004034 

004035 

004036 

104037 

004038 

204039 

004040 

304041 

004042 

504043 

60^044 

704045 

804046 

004047 

004048 

004049 

004050 

004051 

1604052 

1704053 

1804054 

1904055 

004056 

2004057 

004058 

8304059 

004060 

004061 

004062 

004063 

004064 

004065 

004066 

004067 

004068 

004069 

004070 

004071 

004072 

004073 

004074 

004075 

004076 

004077 

004078 

004079 
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C PEEL OFF DATA FOR GRAVITY GRADIENT EFFECTS ON ELASTIC COORDINATES 
C 

DO 8 J=1»LE 
GGS(JtltN) = CH(Jtll 
GGS(J,2«N) CW(J,2) 

GGS(J»3»N) = CW(J,3) 

GGS(JtTtN) s RW(ltJ) 

GGS(Jf8tN) - RW(2tJ> 

8 GGS(J«9tN) = RW(3»J) 

C 

CALL MULT3 ( Yf LO) ,C W«WV( 1 } *1 tLE»3 *1 tKM »1 ) 

CALL MULT3 (RW»Y( LO ) ,WV( A) »3 »LE»I »3*1 » 1 ) 

DO 15 1=1,3 

15 AMU(I,I,N| = AMUfItl.N) + TWO*VWfI) + WV(I) 

AMU(1,2,N) = AMUI1,2,N) - VWf4) - WVI4) 

AMUI1,3,NI = AMUU,3,N) - VH<5) - WV(5) 

AHUf2,3,N) = AMU(2,3,N) - VWC6} - WVI6) 

CALL MULT3 ( ACOF ( 1 ,1 ,N ) ,Y f LO) ,VW,P ,LE,1 ,<»,1 , 1 ) 

DO 17 J=l,3 
JP3 = J ♦ 3 
DO 17 1=1,3 
IJ = J + 3*fl-n 

17 AMIM1,JP3,N*» = ANU(I,JP3,N» ♦ VHIIJI 

CALL MULTAD |Y (LO) ,COFYZf 1 , 1,N> ,AMU( 1 ,7 ,N ) ,1 ,LE,LE ,1 ,KM ,KMU) 
CALL MULTAD (YILO) ,COFXZI 1, 1,N) ,AMU(2,7,N) , 1 ,LE,LE, 1,KM,KMU) 
CALL MULTAD tYILO) ,COFXYf 1 ,1,N) ,AMU(3,7,N) ,1 ,LE,LE ,1 ,KM,KMU) 

C 

CALL HULT3 (C0F12 I 1 ,1 ,N) ,Y(LO) ,CW(1 ,1 ) ,LE,LE,1 ,KM,1,KM ) 

CALL MULT3 (COF 13(1 ,1 ,N) ,Y f LO) ,CW H ,2 ) ,LE ,LE ,1 ,KM ,1 ,KM) 

CALL MULT3 (C0F23( 1,1 ,N) ,Y(LO) ,CW< 1,3) ,LE ,LE ,1,KM, l,KM ) 

C 

C FINISH PEELING OFF GRAVITY GRADIENT DATA 
C 

DO 28 J=1,LE 
GGS(J,4,N) = CW(J,1) 

GGS(J,5,N) = CW(J,2) 

28 GGS(J,6,N) = CW(J,3) 

C 

C 

50 NMMVS == NM0W(2,N) 

IF (NMWVS .EQ. 0) GO TO 110 
NMW = NM0W(1,N) 

LEES = 6 + LE 
NV = 0 

J1 = LFBS + 1 
J2 = LESS ♦ NMWVS 
DO 70 L=1,NMH 
LP2 = L ♦ 2 
NOMW = NM0W(LP2,N) 

IF (IMC(3,N0MW) ,EQ, 0) GO TO 70 


004080 

004081 

004082 

004083 

004084- 

004085 

004086 

004087 

004088 

004089 

004090 

004091 

004092 

004093 

004094 

004095 

004096 

004097 

004098 

004099 

004100 

004101 

004102 

004103 

004104 

004105 

004106 

004107 

004108 

004109 

004110 

004111 

004112 

004113 

004114 

004115 

004116 

004117 

004118 

004119 

004120 

004121 

004122 

004123 

004124 

004125 

004126 

004127 

004128 

004129 



MV = NV + 1 

OOA130 


LV = 6 ♦ LB ♦ NV 

004131 


NOSP = IMOfltNOMW) 

004132 


NA = IM0(2tN0MW) 

004133 


AJS = AH0(2»N0MWI 

004134 


DO 75 JtlfLBBS 

004135 

75 

AMU(JtLV«NI AJS*BS(NA.J.NCSP) 

004136 


DO 76 J=J1 ,J2 

004137 

76 

AMUfLVvJ.N) = ZRO 

004138 


AMU(LVfLV*N) £ AJS 

004139 

70 

CONTINUE 

004140 

110 

LEU = LBNU(N) 

004141 

004142 


on 77 1=1, LFU 

004 143 


00 77 J=I,LBU 

004144 

77 

AMU(J,I,N) = AMUdtJ.M) 

004145 

10 

CONTINUE 

004146 

004147 


RETURN 

004148 

004149 


END 

004150 
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(H0G,P MLTSR -004151 

rPORflS MLTSR -004152 

COMPILFR |XM=l),IFQUlVsCMN) -004153 

SUPRCrUTINE MLTSR ( At B»CtLEtLM«L»IVtKMU) 004154 

IMPLICIT DOUBLE PREC1SION(A-M,0-Z) -004155 

DIMENSION A(6yn«BfKMUfl)»C(6«UtIV(6tl)»RWf12) 8604156 

C 004157 

00 10 1=1,6 004158 

IL = IVll.L) 004159 

IF IlL .EO. 0) GO TO 10 004160 

00 15 K=1,LF 004161 

15 RWCK) = AII,K) 004162 

DO 20 J=1,LM 004163 

S = O.D 0 004164 

no 25 K=1,LE 004165 

25 S = S ♦ RW(K)*P(K,J) 004166 

20 CCI,JI = S 004167 

10 CONTINUE 004168 

C 004169 

RETURN 004170 

END 004171 



Ill 


CHDGtP NRIGID 
IFOR, IS MRIGIO 

COMPILER (XM=n,(EQUIV=CMN) 
SUBROUTINE MRIGID CN) 

IMPLICIT OOUPLE PRECISION! A-H,0-Z> 
C 


COMMON /NHNS / 

♦ NHPOIf 5», NSPOIf 5) 

COMMON /SPECIF/ 

♦ BETAHC6, 5),BETAHD!6, 5),AMO(2, 5) ,RHf 3,3,241 ,RS !3,3,?0 ) , 

♦ DHI3,?8),DS(3,20),IM0!3, 5),MMOM!5, 51 ,IFTSMVmO», 

♦ N6,NH,NSPT,NOFMO,NDELTA,ITOPOLI2, 5),IRGFLXf 5},IHDATA!7, 5), 

♦ LOCU! 12 ) fLENU (12) ,NU,NBETA ,NLAM ,NEO 

COMMON /SUMMRY/ 

♦ ASUMR Y( 10,6) , ISUMRY! 10,3 ) ,KSUHRY 

COMMON /TAPENO/ 

♦ NTAPE1,NTAPE2,NTAPE3 
C 

DIMENSION V(6),AINER(6t6) 

DATA NIT, NOT /5, 6/ 

1001 FORMAT (1615) 

1002 FORMAT (80 10 .3) 

3001 FORMAT (//15X30HSUMMARY OF INPUT DATA FOR B0DY,I3, 

♦ 16H WHICH IS RIGID. //3X29HTHE 6X6 INERTIA MATRIX IS ) 

3002 FORMAT (//5X9HF0R BODY I3,33H THE P-Q HINGE NO. AND THE EULER 

♦ 57HR0TATI0N TYPE APPEAR IN THE FOLLOWING INTEGER ARRAY WHICH / 

♦ 5X57H IS FOLLOWED BY AN ARRAY CONTAINING EULER ANGLES (1,2,3), 

♦ 5 EH AND POSITION VECTOR COMPONENTS (4,5,6) THAT POSITION THE / 

*■ 5X30HHINGE TRIAD WRT THE BODY TRIAD) 

3003 FORMAT (//5X9HF0R BODY I3,35H THE SENSOR POINT NO. AND THE EULER 

♦ 58 H rotation TYPE APPEAR IN THE FOLLOWING INTEGER ARRAY WHICH / 

♦ 5X56H1S FOLLOWED BY AN ARRAY CONTAINING EULER ANGLES! 1 ,2,3) , 

♦ 56 HAND POSITION VECTOR COMPONENTS (4,5,6) THAT POSITION THE/ 

♦ 5X31HSENS0R TRIAD WRT THE BODY TRIAD) 


NHE * NHPOKN) 

NSB = NSPOKN) 

CALL ZERO (AINER,6,6,6) 

CALL READ (V,Nl,N2,l,6) 

DO 5 J=2,4 

5 V(J) = -V(1)*V(J) 

CALL SKEWV3 ( V(2 ) , AINER (1 ,4 ) , 1 ,6) 
DO 6 1=4,6 

6 AINER(I,I) = V(l) 

CALL READ (V,N1,N2,1 ,6) 

DO 7 1=1,3 

7 AINER(I,1) = V(I) 

AINER(1,2) = -V(4) 

AINER(1,3) = -V(5) 


-004172 
-004173 
-004174 
004175 
-004176 
004177 
004178 
1204179 
004180 
1604181 
1704182 
1804183 
1904184 
004185 
9804186 
004187 
004188 
004189 
004190 
004191 
004192 
004193 
004194 
004195 
004196 
004197 
004198 
004199 
004200 
004201 
004202 
004203 
004204 
004205 
004206 
004207 
004208 
004209 
004210 
004211 
004212 
004213 
004214 
004215 
004216 
004217 
004218 
0042 19 
004220 
004221 
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/aNER(2,3) = -V(6I 
00 8 1 = 1,6 
DO 8 J=I,6 

8 AINFR(J,n = AINERfI,J) 

WR ITE (NTAPEll ( f AINER 1 1, J ) , J=1 ,6 1 ,1=1 , 6) 

CALL PAGEHO 

WRITE (NOT, 30011 N 

CALL WRITES (AINER ,6,6,6) 

00 10 1=1, NHB 

READ (NIT, 10011 NOH,ITYPE 

ISUMRY(I,1) = NOH 

ISUMRYd,?) = ITYPF 

IF (NOH .EQ. 11 GO TO 999 

LR = 6*(N0H -21+3 

LO = 7*(N0H -21+3 

IF (ITPP0L(1,NCH) .EO. Nl GO TO 12 

IF (ITOPOL (2,N0H1 .NE. Nl GO TO 999 

LR = LR + 1 

LD = LD + 1 

12 READ (NIT,1002) (V(J),J=1,31 

READ (NIT,1002) (DH( J,LD1 , J=1 ,3 1 
00 11 J=l,3 
J1 = J ♦ 3 
ASUMRY(I,J I = V(JI 
11 ASIIMRY(I,J1) = DH(J,LDI 

CALL ROTTR (3,ITYPE ,V,RH( 1 ,1 ,LR 1 •DUM,0UM} 
10 CONTINUE 

WRITE (NOT ,3002) N 

CALL WRITIS (ISUMRY,NHB,2,KSUMRY) 

CALL WRITES ( ASUMRY,NHB,6,KSUMRY) 

IF (NSB .EC. 01 RETURN 

DO 20 1=1, NSB 

READ (NIT, 10011 N0S,ITYPE 

ISUMRYd,! I = NCS 

ISUMRYd, 21 = ITYPE 

IF (IFTSMM(NOS) .NE. N| GO TO 999 

LR = 2*N0S 

READ (NIT, 1002) (V(J),J=1,31 
READ (NIT, 1002) (DS( J,LR ) , J=1 ,3 1 
DO 21 J=l,3 
J1 = J + 3 
ASUMRYd,J 1 = V(J1 
21 ASUMRY(I,J1) = DS(J,LR) 

CALL ROTTR (3,ITYPE ,V,RS ( 1 ,1 ,LR) ,DUM,DUM) 
20 CONTINUE 

WRITE (NOT, 3003) N 

CALL WRITIS (ISUMRY,NS6,2,KSUMRY1 

CALL WRITES ( ASUMRY,NSB,6,KSUMRY) 


004222 

004223 

004224 

004225 

004226 

004227 

004228 

004229 

004230 

004231 

004232 

004233 

004234 

004235 

004236 

004237 

004238 

004239 

004240 

004241 

004242 

004243 

004244 

004245 

004246 

004247 

004248 

004249 

004250 

004251 

004252 

004253 

004254 

004255 

004256 

004257 

004258 

004259 

004260 

004261 

004262 

004263 

004264 

004265 

004266 

004267 

004268 

004269 

004270 

004271 
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RETURN 004272 

C 004273 

999 WRITE (NOT *2001) 004274 

2001 FORMAT C1H1,49HT0P0L0GV ERROR tSUBROUTINE MRIGIDt PROGRAM STOPPED) 004275 

STOP 004276 

C 004277 

END 004278 
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IHOGtP HSHODC 
[FORL»IS MSMODC 

COMPILER f XM=1»,<E0UIV=CMN) 

SUBROUTINE MSHODC fNBOD) 

IMPLICIT DOUBLE PREC ISIONU-H.O-ZI 
C 

COMMON /MAXMUM/ 

♦ NBMAX ,NHMAX,NSPMAX,NMWMAX»NMMBOD,NMDBOD,KMU,KY,KU 

COMMON /NHNS / 

♦ NHPOl I 5)r NSPOII 51 

COMMON /NUMBRS/ 

♦ ZRO,ONE,TWO»TRES 

COMMON /SPECIF/ 

♦ BETAHC6, 5»fBETAHDC6* 5)»AMOI2t 5) *RHl3f3*24 ) ,RS (3,3 ,20 ) , 

♦ DH(3,28),0S(3,20),IM0(3, 5I,NH0W(5, 51 .IFTSMWdOl , 

♦ N6,NH,NSPT,NOFMO,NOELTA,ITOPOLI2, 5»,IRGFLX( 5),IH0ATA(7, 5», 

♦ LOCU( 12l,LENU(12),NU,NBETA,NLAM,NEO 

COMMON /SUMMRY/ 

♦ ASUMRY(10,6I,ISUMRY(10,3),KSUMRY 

COMMON /TAPENO/ 


♦ NTAPE 1,NTAPE2,NTAPE3 

DIMENSION A{ 42, 42»,?! 42, 

♦ BCIQ, 6),WS1( 6, b),»rS2( 


42),IV( 42),JV( 42I,C(6,6),PHR6(6,6), 
6, 6),0H2( 42),OMGA2(I2),JDOF( 7,6) 


DATA NIT,NOT,KAB,KJDOF/ 5,6, 42, 7 / 

1001 FORMAT (1615) 

1002 FORMAT (8D10.3) 

3001 FORMAT ( //15X30HSUMMARY OF INPUT DATA FOR BODY, 13, 

* 44-H which is flexible W/CONSISTENT MASS MATRIX.// 

* 3X49HTHE INTEGER PARAMETERS IFRBM,IFOIAK,IFDT AD ARE5XI2,1H, 

* 5X12, IH, 5X12,// 

* 3X25HTHF JDOF TABLE FOLLOWS ) 

3002 FORMAT (//3X36HTHE MODE SELECTION VECTOR FOLLOWS ) 

3003 FORMAT (//3X12HF0R BODY NO.,I3,25H THE POSITION VECTOR FROM 
♦25H THE BODY ORIGIN TO JOINT, I4,3H IS, / 

* lOX 4HX = 1PD10.3,5X5H Y = 1PD10.3,5X5H Z = 1P010.3) 

3004 FORMAT (//5X46HTHE CONSISTENT, REPARTITIONED MASS MATRIX IS — ) 

3005 FORMAT (//5X36HTHE REPARTITIONEO MODAL MATRIX IS—) 

3006 FORMAT (//5X44HTHE -UNDEFORMED- INERTIA MATRIX (MU) IS ) 

3007 FORMAT (//5X27HTHE A COEFFICIENTS ARE ) 

3008 FORMAT (//5X27HTHE E COEFFICIENTS ARE -) 


-004279 
-004280 
-004281 
004282 
-004283 
004284 
004285 
004286 
004287 
1204288 
004289 
004290 
004291 
1604292 
1704293 
1 804294 
1904295 
004296 
9804297 
004298 
004299 
004300 
6104301 
6204302 
004303 
6304304 
004305 
004306 
004307 
004308 
004309 
004310 
004311 
004312 
004313 
004314 
004315 
004316 
004317 
004318 
004319 
004320 


3009 

FORMAT 

(//5X31HTHE 

COFXY 

COEFFICIENTS 

ARE ) 

004321 

3010 

FORMAT 

(//5X31HTHE 

COFXZ 

COEFFICIENTS 

ARE ) 

004322 

3011 

FORMAT 

(//5X31HTHF 

COFYZ 

COEFFICIENTS 

ARE ) 

004323 

3012 

FORMAT 

(//5X31HTHE 

Cll 

COEFFICIENTS 

ARE—) 

004324 

3013 

FORMAT 

(//5X31HTHE 

C22 

COEFFICIENTS 

ARE ) 

004325 

3014 

FORMAT 

(//5X31HTHE 

C33 

COEFFICIENTS 

ARE ) 

004326 

3015 

FORMAT 

(//5X31HTHE 

C12 

COEFFICIENTS 

ARE ) 

004327 

3016 

FORMAT 

(//5X31HTHE 

C13 

COEFFICIENTS 

ARE ) 

004328 


115 



3017 R3RMAT 1//5X31HTHF C23 COEFFICIENTS ARE I 

3018 FORMAT C//5X33HTHE MODAL STIFFNESS MATRIX IS ) 

3019 FORMAT (//5X31HTHF MODAL DAMPING MATRIX IS I 

3020 FORMAT C//5X50HTHE INITIAL MODAL COORDINATE DISPLACEMENTS ARE I 

3021 FORMAT I//5XA7HTHE INITIAL MODAL COORDINATE VELOCITIES ARE ) 

3022 FORMAT (//5X 9HF0R BODY I3,29H THE P-0 HINGE NO,, THE EULER 

♦ 57H ROTATION TYPE AND THE JOINT NO. CORRESPONDING TO THE P-Ot/ 

♦ 5X5AH HINGE APPEAR IN THE FOLLOWING INTEGER ARRAY WHICH IS 

♦ . 49HF0LL0WED BY AN ARRAY CONTAINING EULER ANGLES THAT,/ 

♦ 5X4AH POSITION THE HINGE TRIAD WRT THE BODY TRIADI 

3023 FORMAT C//5X 9HF0R BODY I3,32H THE SENSOR POINT NO., THE EULER 
♦60H ROTATION TYPE AND THE JOINT NO. CORRESPONDING TO THE SENSOR,/ 
♦6X53HP0INT APPEAR IN THE FOLLOWING INTEGER ARRAY WHICH IS 

♦ 49HFOLLOWED BY AN ARRAY CONTAINING EULER ANGLES THAT,/ 

♦ 5X45H POSITION THE SENSOR TRIAD WRT THE BODV TRIAD! 

C 

REWIND NTAPE2 

KMO = NMDBOD 

CALL ZERO (PC, 9, KMO, 91 

READ (NIT, 1001) IFRBM, IDI AK ,IDIAO 

CALL READIM ( JDOF,NX ,N6 ,K JDOF ,6 ) 

IC = 0 
DO 2 J=l,6 
DO 2 1=1, NX 
NDF = JDOF I I, J) 

1C = IC + 1 

2 IV«NDF) = IC 

CALL READIM ( JV,N1 ,N2 , 1 ,KAB ) 

NY = NX 
NZ = NX 
NMO = 0 
CALL PAGEHO 

WRITE (NOT, 3001) NBOD, IFRBM, IDIAK, IDIAD 
CALL WRITIS (JDOF,NX,6,KJDOF) 

WRITE (NOT, 3002) 

CALL WRITIS (JV,1,N2,1) 

C 

DO 3 I = 1,N? 

IF (JV(I) .EO. 0) GO TO 3 
NMO = NMO + 1 

3 CONTINUE 

IF (NMO .GT. KMO +6) GO TO 999 
CALL READ (A,NRA,NtA,KAE,KAB) 

CALL REVISF (A,1V,IV,B*NRA,NCA,NRA,NRA,KAB,KAB ) 

WRITE (NTAPE2) ( ( B ( I , J ) ,I =1 ,NRA ) , J=1 ,NR A ) 

REWIND NTAPE2 
C 

CALL READ (A ,NRA ,NMOT,KAB ,KAB ) 

IF (IDIAK .EQ. 0 .AND. IDIAD .EQ. 0) GO TO 11 
CALL READ I0M2 ,N1, N2, 1,KAB ) 


004329 

004330 

004331 

009332 

004333 

004334 

004335 

004336 

004337 

004338 

004339 

004340 

004341 

004342 

004343 

004344 

004345 

004346 

004347 

004348 

004349 

004350 

004351 

004352 

004353 

004354 

004355 

004356 

004357 

004358 

004359 

004360 

004361 

004362 

004363 

004364 

004365 

004366 

004367 

004368 

004369 

004370 

004371 

004372 

004373 

004374 

004375 

004376 

004377 

004378 


- 
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11 NE = NHO - 6 

CALL REVISE (AtIVtJV»BfNRA«NMOTtNRA«NMOtKAB»KAB) 

IF (IDIAK .FO. 0 .AND. IDIAD .EQ, 0) GO TO 12 
CALL REVISE tON2fl »JVfOHGA2»l tN2tl»NH0» 1*1) 

1? IF CIFRBM .EO. 0) GO TO 5 
READ (NIT, 1001) JTYPCL 
READ (NIT,1002) (0M2 ( J ) ,Jsl,3 ) 

WRITE (N0T,3003) NBOD, JTYPCL, 0H2( 1 ) ,0M2 (2 ) ,OH2(3 ) 

JRB a JTYPCL - NX 
00 4 1=1,6 
JRB = JRB + NX 
00 4 J*l,6 

4 PHR6(I,J) = B(JBE,J) 

CALL GAUSSl (PHR6,C,6,6) 

CALL ZERO (PHR6(4,4),3,3,6) 

CALL UNITY ( PHR6 (1 ,4 ) ,3,6) 

CALL UNITY ( PHR6 (4,1 ) ,3,6 } 

CALL SKEWV3 (0M2 ,PHR6, 1 ,6 ) 

CALL MULTA (C ,PHR6,6 ,6 ,6 ,6 ,6 ) 

CALL MULTA (B,C,NRA,6,6,KAB,6) 

C 

5 READ (NTAPE2) ( ( A( I, J ) , 1=1 ,NRA) , J=) ,NRA ) 

REWIND NTAPF2 

WRITE (NOT, 3004 1 

CALL WRITES (A ,NRA ,NP A,KAB) 

WRITE (NOT, 3005) 

CALL WRITES (6 ,NRA ,NMO,KAB) 

C 

CALL 6TABA ( A,B ,NRA,NMO,KAB ,KAP ) 

WRITE (NOT ,3006) 

CALL WRITES (A ,NMO,NMO,KAB) 

WRITE (NTA»E1) ( ( A ( I , J ) , J=I ,NMO ) , 1=1 ,NMO) 

DO 25 J=1,NE 
JP6 = J ♦ 6 

25 0M2(J) = A(JP6,JP6) 

C 

READ (NTAPE2) ( ( A( I, J ) , 1=1 ,NRA) ,J=1 ,NRA ) 

REWIND NTAPE2 
NRP = 3*NX 

i- CALL MULTA ( A,B,NRP,NRA,NMO,KAB ,KAB ) 

CALL ZERO (BC,9,NE,9) 

DO 15 J=1,NE 
K = 6 ♦ J 
DO 15 IX = 1,NX 
lY = IX + NX 
IZ = lY + NX 

BC(1,J) = BC(1,J) ♦ A(IZ,4)4B(IY,K) - A (IY,4)4B(IZ,K) 

6C(2,J) = RC(2,J) + A(IZ,5)*B(IY,K) - A (IY,5)«B( IZ,K) 

BC(3,J) = BC(3,J) ♦ A(IZ,6)4B(IY,K) - A ( IY,6 )«B ( IZ ,K) 

BC(4,J) = BC(4,J) ♦ A(IX,4)*6(IZ,K) - A (IZ,4)*B( 1X,K) 


004379 

004380 

004381 

00*^382 

004383 

004384 

004385 

004386 

004387 

004388 

004389 

004390 

004391 

004392 

004393 

004394 

004395 

004396 

004397 

004398 

004399 

004400 

004401 

004402 

004403 

004404 

004405 

004406 

004407 

004408 

004409 

004410 

004411 

004412 

004413 

004414 

004415 

004416 

004417 

004418 

004419 

004420 

004421 

004422 

004423 

004424 

004425 

004426 

004427 

004428 
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BC(5,J) = BC(5«JI ♦ A(IX,5)*BIIZ*K) - A(IZ«5I*B( IXtK) 

BCf6,J) = BC(6tJ) + Af IXy6)4'6f IZtK) - A(lZ»b)*B(IXtK) 

BCI7,J» = eC{7,J) ♦ Af IY,4I*B(IX,K1 - A I IX, A |*B ( I Y,K 1 

6C(8,J) = BCte.J) ♦ ACIY,6}*Bf IX,K» - A(IX,5)*B( IY,Ki 

BC(9,JI = BC(9,J) ♦ AIIY,6)*BfIX,K» - A f TX,6)4r6 1 lY.Kl 

15 CONTINUE 

WRITE (NTAPEll MBCI I,JI ,J=1,NF»,I=1,9» 

WRITE (NOT, 30071 

CALL WRITES (BC , 9,NE , 91 

CALL ZERO (eC,9,NE,9> 

00 16 J=1,NE 
K = 6 ♦ J 
DO 16 IX=l,NX 
lY = IX + NX 
IZ = lY ♦ NX 

BCn,J) = ec(l,j) ♦ A(IZ,1)*B(1Y,K> - A(1Y,1)*B(IZ,K» 

BC(2,J) = BC(2,J) ♦ A(IX,2I*BIIZ,KI - A (TZ,2)*R( IX,K) 

PC(3,JI = PC(3,J) ♦ AlIY,3»*BfIX,K» - A ( IX , 3 )*B ( IY,K ) 

BC(A,JI = BC(4,J) ♦ A(1Z,1 »*B(IX,K) - A ( IX, 1 ) *B ( IZ ,K) 

♦ ♦ Af IY,2I*B(1Z,K) - A(IZ,2)*B( IY,K) 

BC(5,J) = 8CI5,J» ♦ AI1X,1I*BI1Y,K» - A ( lY, 1)*B( IX ,KI 

♦ ♦ A(IY,3)*B(IZ,K) - A(IZ,3)*B(IY,K) 

BC(6,J1 = 6C(6,J) ■» A( IX,2»*B(IY,K) - A I lY, 2»*B ( IX,K1 

♦ ♦ A(IZ,3I*B(IX,K) - A(IX,3)«B(IZ,K) 

16 CONTINUE 

WRITE (NTAPEl) ( (BC ( I , J) , J=i,NE » , 1=1 ,6) 

WRITE (NOT ,30081 

CALL WRITES (BC , 6,NE , 9) 

CALL ZERO (WS1,NE,NE,KM0I 

00 17 1=1, NE 

K1 = 6 I 

00 17 J=1,NE 

KJ = 6 ♦ J 

DO 17 IX=1 ,NX 

lY = IX ♦ NX 

IZ = lY ♦ NX 

WS1(I,J) = WS1(I,J) ♦ B(IX,KII*A(IY,KJ) - B ( IY,K1 ) *A( IX ,K J ) 

17 CONTINUE 

WRITE (NTA*“F1) ( (WSl ( I , J ) , J=1 ,NE ) , 1 = 1 ,NF» 

WRITE (NOT, 30091 

CALL WRITES (WS1,NF ,NE ,KMOI 

CALL ZERO (WSI,NE,NE,KMC) 

00 18 1=1, NF 
KI = 6 ♦ 1 
DO 18 J=1,NE 
KJ = 6 ♦ J 
00 18 1X=1,NX 
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lY = IX ♦ NX 
rz = lY ♦ NX 

WSKltJ) = WSKItJl * B(IZ«KII*AIIX,K«?) - B « IX,Kt |*Af 1Z,KJI 

18 continue 

HRITF INTAPEll (IWSl f ItJ) tJ=l tNE)»I=ItNEI 
WRITE (NOT ♦3010) 

CALL WRITES (US1,NE ,NE ♦KMOI 
C 

CALL ZERO IWSl,NE,NEtKMOI 

DO 19 1=1 tNE 

KT = 6 + 1 

DO 19 J=1,NE 

KJ = 6 ♦ J 

00 1® IX =1 ,NX 

lY = IX ♦ NX 

IZ = lY ♦ NX 

WSKltJ) WSIII.J) ♦ B(1Y,KI)»A(IZ,KJ) - B(1Z*KI)«A( IV.KJ) 

19 CONTINUE 

WRITE (NTAPFl) ( (WSl ( I ♦ J ) *J=1 ♦NE) , 1=1 «NE) 

WRITE (NOT ,3011 I 

CALL WRITES (WSl.NE ,NE ,KMO) 

C 

LX = 1 

LY = LX ♦ NX 

LZ = LY ♦ NY 

SI = ONE 

C 

READ (NTAPE2) ( ( A (I ♦ J ) ,1 =1 , NRA ) , J=1 ,NRA ) 


CALL ZERO (WSl,Nf,NE,KMO) 

CALL PP3 f ACLZtLZ),B(LY,7)*8CLY,7),WS2,WSl, SI ,NZ ,NZ*NE,NE, 

* KAR,KAB,KA6,KJ00F,KM0) 

CALL PR3 ( A(LZtLY) ,B(LZt7),BILY,7)»WS2,WSl,-Sl»NZ»NY,NE,NE, 

* KAB,KAB,KAPfKJOOF,KMO) 

CALL PR3 « A(LY,LZ),G(LY,7),P(LZ,7),WS2,WS1,>S1,NY,NZ,NE,NE, 

* KAB,KAB,KAB,KJDOF«KNO) 

CALL PR3 ( A(LY,LY) ,B CLZ,7),B(LZt7),WS2,WSl, SI ,NY,NY,NE,NE , 

* KAB,KA6,KAB,KJD0F,KM0) 

WRITE (NTAPEI) ( (WS1(],J) •J=1,NE),I=1,NE) 

WRITE (NOT, 3012) 

CALL WRITES (WSl ,NE ,NE ,KMO) 

CALL ZERO (WS1,NE,NE ,KMO) 

CALL PR3 ( A(LX,LX),B(LZ,7),B(LZ,7),WS2fWSl, SI ,NX ,NX,NE,NE, 

* KA6,KAB,KAB,KJD0F,KMC) 

CALL PR3 ( A(LX,LZ),6(LX,7),B(LZ,7),WS2,WSl,-Sl,NX,NZfNE,NE, 

* KAP,KAP,KAB,KJOOF,KMO) 

CALL PR3 (A(LZ,LX),B(LZ,7),6(LX,7),WS2,WS1,-S1,NZ,NX,NE,NEt 

* KAB,KAB,KAB,KJD0F,KM0) 

CALL PR3 ( A(LZ,LZ) ,B(LX,7),B(LX,7),WS2,WS1, SI ,NZ ,NZ,NE,NE , 
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004498 

004499 
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004501 
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004508 
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004516 
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♦ KABtKAB«KAB*KJDOF»KMOI 

WRITE <NTAPE1I f (WSKItJI *J-1»NE)»I=^1«NEI 

WRITE (N0Tt3013l 

CALL WRITES fWSl«NE «NE »KMO) 

CALL ZERO IWSl«NE»NEtKMOI 

CALL PR3 IA<LY,LV),BCLX,7),BCLX,7I*WS2.WS1, SI .NY,NY,NE,NE , 

♦ KAB»KAB»KABtKJDOF,KMO) 

CALL PR3 IA(LY,LX).BaY*7»*P(LX,7»,WS2#WSl,-Sl,NY,NXtNE,NE, 

♦ KAB«KAB*KA6»KJD0F»KM0) 

CALL PR3 < AILXtLY»,BCLXt7>,B(LY,7»,WS2fWSl,-Sl,NX,NY,NE,NE, 

♦ KAB*KABtKAB»KJDOFtKMO) 

CALL PR3 CA(LX,LXI,BCLV,7»,BCLY.7I,WS2,WS1* $1 ,NX ,NX*NE,NE, 

♦ KABtKABtKAB»KJOOF»KMOI 

WRITE (NTAPEl) I CWSl < ItJ) tJ=ltNE» tl=lfNF) 

WRITE (NOT *301 

CALL WRITES (WS1«NE *NE »KMO) 

CALL ZERO (WS1*NE»NE*KM0) 

CALL PP3 (A(LZ*LX»,BCLZ*7),BCLY,7)*WS2*WS1*-S1*NZ*NX*NE,NE, 

♦ KA6*KAB«KAB*KJD0F*KMCI 

CALL PR3 (A(L2*LZ),BCLX,7I,B(LY*7),WS2*WS1, S1*NZ«NZ*NE»NE* 

♦ KAB*KAB*KAB*KJOOFtKMO) 

CALL PR3 (AILY»LX)»B(LZ»7)*B(LZ*7)*WS2*WS1» S1*NY*NX,NE*NE» 

♦ KA8*KAB*KAB*KJD0F»KM0) 

CALL PR3 (A(LY,LZI,B(LX,7>,B(LZ,7»,WS2,WS1,-S1,NY,NZ*NE*NE, 

♦ KAB*KAB*KA6«KJD0F«KMC> 

WRITE (NTAPEl! ( (HSl ( I * Jl *J=1 *NEI ,I-1*NE! 

WRITE (NOT, 3015) 

CALL WRITES (WS1,NE ,NE ,KMO! 

CALL ZERO (WSl,NE,NE,KMO) 

CALL PR3 ( A(LZ,LYI,B(LX,7),B(LY,7),WS2.WS1,-S1,NZ,NY,NE,NE, 

♦ KAB,KAB,KAB*KJDOF,KHO) 

CALL PR3 (A(LZ,LX),B(LY,7!,E(LY,7!,WS2,WS1, S1*NZ ,NX*NE*NE, 

♦ KAB,KAB*KA6*KJ00F,KM0) 

CALL PR3 (A(LY,LY),B(LX,7I,E(LZ,7!,WS2,WS1, S1,NY,NY,NE,NE, 

♦ KAB,KAB,KAB,KJDQF,KMO) 

CALL PR3 (A(LY,LX),B(LY,7!,B(LZ,7!,WS2,WS1,-S1,NY,NX,NE,NE, 

♦ KAB*KAB,KAB,KJDOF,KMO) 

WRITE (NTAPEl) ( (HSl ( I ) , J=1 ,NE ) , 1=1 ,NE) 

WRITE (NOT, 3016) 

CALL WRITES (WS1,NF ,NE ,KMO) 

CALL ZERO (WS1,NE,NE,KM0) 

CALL PR3 (A(LX,LY),B(LX,7),B(LZ,7),WS2,WS1,-S1,NX,NY,NE,NE, 

♦ KAB,KAB,KAP,KJDGF,KMO) 

CALL PR3 ( A(LX,LX) ,B(LY,7),B(LZ,7),WS2,MS1, S1,NX,NX,NE,NE, 
» KAP,KAP,KAB,KJDOF,KMO) 

CALL PR3 ( A(LZ,LY),B(LX,7),B(LX,7),WS2,WS1, S1,NZ,NY,NE,NE, 

♦ KAB,KAB,KAB,KJOOF,KMC') 

CALL PR3 ( A(LZ,LX),B(LY,7),B(LX,7),WS2,WS1,-S1,NZ,NX,NE,NE, 

♦ KAB,KAB,KA6,KJDCF,KMG) 

WRITE (NTAPEl) ( ( WSl ( I , J) , J=1 ,NE) , 1=1 ,NE) 
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WRITE INOT ,30171 

CALL WRITfiS fWSltNE ,NE ,KMO) 

C 

IE fIDIAK .EQ. n GO TO 50 
CALL READ fA,NRA,NCA,KAB,KAB) 

CALL BTABA (A,BI1,7) ,NRAfNE,KA6,KAB) 

GO TO 51 

50 CALL ZERO (A,NE,NE ,KA6) 

DO 55 J=1,NE 

JP6 = J ♦ 6 

55 A(J,J) - 0MZU)*0M6A2f JP6) 

51 WRITE (NTAPEl) ( f Af I,J) ,Jsl,NE),Isl,NEI 
WRITE (NOT ,301 B) 

CALL WRITES (A ,NE ,NE ,KAB) 

IF (lOlAD .F0« 1) GO TO 60 
CALL READ (A ,NRA ,NCA ,KAB,KAB) 

CALL BTABA (A,B(1,7) ,NRA,NE,KAB,KAB) 

GO TO 61 

60 CALL ZERO (A,NE,NE,KAB| 

DO 65 J=1,NE 

JP6 = J ♦ 6 

65 0MGA?(JP6l = TWO«OMZ(J)*OSQRT(GNGA?(JP6)) 

READ (NIT,1002) (0M2 ( J ) , J^l ,NE ) 

DO 66 J=1,NE 
JP6 = J ♦ 6 

66 A(J,J) = OH2(J)*CMGA2( JP6) 

61 WRITE (NTAPEl) ( (A(I, J) ,Js=l,NE),Isl,NE) 

WRITE (NOT, 3019) 

CALL WRITES (A ,NE ,NE ,KA6) 

C 

READ (NIT,1002) (0M2 ( J ) ,J>1 ,NE) 

WRITE (NTAPEl) (0M2( J ) , J>1,NE ) 

WRITE (N0T,3020) 

CALL WRITES (0M2, 1,NE , 1) 

READ (NIT, 1002) (0M2( J) ,Jsl,NE) 

WRITE (NTAPEl) (0M2( J ) , J=1 ,NE ) 

WRITE (NOT ,3021) 

CALL WRITES (CM2, 1 ,NE , 1) 

C 

NHE = NHPOKNBOD) 

NSB = NSPOKNBOO) 

CCC NHB IS NO. OF P-0 HINGES ON THE BODY, NOT TO INCLUDE HINGE 1 
WRITF (NTAPEl) NHB 
DO 110 LsI,NH6 

READ (NIT, 1001) NOH, ITYPE, JOINT 
ISUMRY(L,1) a NOH 
ISUMRY(L,2) a ITYPE 
ISUMRY(L,3) a JOINT 

IF (NOH .LT. 2 .OR. NOH ,GT. NH) GO TO 998 
LR a 6«(N0H - 2) + 1 


004579 

004580 

004581 

004582 

004583 

004584 

004585 

004586 

004587 

004588 

004589 

004590 

004591 

004592 

004593 

004594 

004595 

004596 

004597 

004598 

004599 

004600 

004601 

004602 

004603 

004604 

004605 

004606 

004607 

004608 

004609 

004610 

004611 

004612 

004613 

004614 

004615 

004616 

004617 

004618 

004619 

004620 

004621 

004622 

004623 

004624 

004625 

004626 

004627 

004628 


1 


^^ 1 '- 


121 



LO = 7*lf«H “ 2) ♦ 1 

004629 


IF (ITCPOLCltNOH) .EQ. NBOD) 60 TO 112 

004630 


IF IITOPOL (2tN0H) .NE. NBODI GO TO 998 

004631 


LR = LR + I 

004632 


LO = LD ♦ 1 

004633 


112 JHX = JOINT 

004634 


JHV = JHX ♦ NX 

004635 


JHZ = JHY + NX 

004636 


JSX = JHZ + NX 

004637 


SY = JSX + NX 

004638 


JSZ = JSY + NX 

004639 


DHlltLD) = B(JHY,3| 

004640 


DHf2.Lt>) = B(JHZtl) 

00^641 


DH(3,LD) =. R(JHX»2) 

004642 


READ CNIT, 1002) (0M2 ( J) .J-1 .3 ) 

004643 


ASUMRYfLtl) = 0M2(1) 

004644 


ASUMRYfL«2) = 0M?(2) 

004645 


ASUMRYfL»3) = 0M2(3) 

004646 


CALL ROTTR (3 tITYPE tOM2 .RHf 1 . 1 .LR ) .DUN .DUM ) 

004647 


00 115 J=1 »NE 

004648 


JP6 = J ♦ 6 

004649 

( 

BCfl.J) = B(JHX»JP6) 

004650 


eC(2,J) = B(JHY»JP6) 

004651 


BCf3tJ) = BfJHZtJPB) 

004652 


BCfA.J) = R(JSX»JP6) 

004653 


BCf5tJ) = BfJSY,JP6) 

004654 


115 6C(6tJ) = E(JSZtJP6) 

004655 


VfRlTF INTAPEl) NOH 

004656 


WRITE (NTAPEl) ( (BC( I. J) . Jsl »NE ) ,1=1 ,3 ) 

004657 

1. 

WRITE (NTAPEl) ( (BC( I , J) , J=I ,NE ), I=A ,6) 

004658 

j.- 

110 CONTINUE 

004659 


WRITE {NOT ,3022) NBOD 

004660 


CALL WRITIS (ISUMRV,NHB,3,KSUMRV) 

004661 


CALL WRITES C ASUMRY.NHB ,3 ,KSUMR Y) 

004662 


C 

004663 

Tt 

WRITE (NTAPEl) NSB 

0C4664 

!’. 

IF (NSB .EO. 0) RETURN 

004665 


DO 120 L=1,NSB 

004666 

!i 

READ (NIT, 1001) NOS, ITYPE .JOINT 

004667 

ii 

ISUMRY(L,1 ) = NOS 

004668 


ISUMRYtL,?) = ITYPE 

004669 

i 

ISUMRY(L,3) = JOINT 

004670 

i 

IF (lETSMWINOS) .NF, NBOD) GO TO 998 

00^671 

j 

LR = 2 ♦NOS - 1 

004672 

i 

JHX = JOINT 

004673 

JHY = JHX + NX 

004674 

"i 

JHZ = JHY •» NX 

004675 

;f 

1 

JSX = JK2 ♦ NX 

004676 

3 

JSY = JSX ♦ NX 

004677 

1 

JSZ = JSY ♦ NX 

004678 


I 
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DSll.LR) = BfJHY,3l 004679 

DS(2»LR) = B(JHZtl) 004680 

DSC3tLR) = B(JHXt2) 004681 

READ (NIT»I002) I0M2 ( J)»J=lt3) 004682 

ASUMRY(L»1) * 0M2(1» 004683 

ASUMRYRtZ) s OM2I2) 004684 

ASUMRY(Lt3) = 0M2(3) 004685 

CALL ROTTR f3tITYPEtON2»RSfl«l*LR)tDUM»DUM> 004686 

00 125 J=1 ♦NC 004687 

JP6 = J ♦ 6 004688 

BCIlyJ) - B(JHXtJP6) 004689 

6C(2«J) s BCJHY*JP6> 004690 

BCf3*J) - B(JHZ«JP6) 004691 

BC(4*J) s B(JSXtJP6) 004692 

BCISfJ) B(JSY,JP6> 004693 

125 » B(JSZ«JP6) 004694 

WRITE INTAPEl) NOS 004695 

WRITE (NTAPEl) ( (BC( I«J) •Jsl»NE)»I~l t31 004696 

WRITE (NTAPEl I ( (BC( I»J),Jsl«NE)»Is4»6) 004697 

1 20 CONTINUE 004698 

WRITE (NOT ,3023) NBCD 004699 

CALL WRITIS (ISUMRY,NSB,3,KSUHPY) 004700 

CALL WRITES ( ASUNRY,N5B,3,KSUMRY) 004701 

C 004702 

RETURN 004703 

C 004704 

998 WRITE (NOT, 2001) 004705 

2001 FORMAT ( IH 1,31HT0P0L0GY ERROR, PROGRAM STOPPED) 004706 

STOP 004707 

999 WRITE (NOT, 2002) 004708 

2002 FORMAT (1H1,47HM0RE THAN NMDBOO MODES SELECTED, PROGRAM STOPPED) 004709 

STOP 004710 

C 004711 

END 004712 
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[HDGyP MSMODL 
[FOR t IS MSMODL 

COMPILFR IXM=1)*IEQUIV=CMN) 
SUBROUTIW MSMODL CNBOD) 

IMPLICIT DOUBLE PREC1SI0NIA-H,0-ZI 
C 

COMMON /NHNS / 

» MHPPI ( 5)t NSPOIC S) 

COMMON /NUMBRS/ 

* ZRO»ONE,IWO,TRES 


COMMON /SPECIF/ 

♦ BETAHC6, 51.BETAHDI6, SlyAMOlZ* 5 1 #RH( 3,3 ,24 ) ,RSf 3,3 ,20 1 , 

♦ DH(3,28I,DS(3,20),IM0(3, 5KNM0WC5, 5) ,IFTSMM(10I , 

♦ NP,NH-,NSPT,NOFMO,NOELTA,1TOPOL{2, 5),IRGFLXl 5),IH0ATAI7, 

♦ LOCUC 12) ,LENUf 12) ,NU,NBETA ,NLAH,NEO 

COMMON /SUMMRY/ 

♦ ASUMR V( 10,6) , ISUMRV(10,3 ) ,KSUMRY 

COMMON /TAPENO/ 

♦ NTAPE 1,NTAPF2,NTAPE3 


DIMENSION A( 105, 6),B( 105, 6),C( 105, 6),AMU( 12, 12) 
DIMENSION MS( 105, 13 ) ,UVEC ( 105),WV(3) 


C 


DATA KJOINT, KMODF 
♦ / 1 05 , 6 / 

DATA NIT, NOT /5,6/ 


5), 


C 

1001 FCRMATC16I5) 

1002 FORM AT (8D1 0.3) 

3022 FORMAT (//5X 9HF0R BODY I3,29H THE P-Q HINGE NO., THE EULER 

* 5TH ROTATION TYPE AND THE JOINT NO. CORRESPONDING TO THE P-Q,/ 

* 5X54H HINGE APPEAR IN THE FOLLOWING INTEGER ARRAY WHICH IS 

♦ 49HF0L LOWED BY AN ARRAY CONTAINING EULER ANGLES THAT,/ 

♦ 5X44H POSITION THE HINGE TRIAD WRT THE BODY TRIAD) 

3023 FORMAT (//5X 9HF0R BODY l3,32H THE SENSOR POINT NO., THE EULER 
♦60H ROTATION TYPE AND THE JOINT NO. CORRESPONDING TO THE SENSOR,/ 
♦6X53HP0INT APPEAR IN THE FOLLOWING INTEGER ARRAY WHICH IS 

♦ 49HF0LL0WE0 BY AN ARRAY CONTAINING EULER ANGLES THAT,/ 

* 5X45H POSITION THE SENSOR TRIAD WRT THE BODY TRIAD) 

C 

KA = KJOINT 
KB = KJOINT 
KC = KJOINT 
KWS = KJOINT 
KAMU = KHODE + 6 
C 

C*** INITIALIZE NTAPE2, N'.APE3 
REWIND NTAPE2 
REWIND NTAPE3 
C 
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C4t***##«****«*4n»)M‘**«*«*4c**:««*****4*4***4*4***4r*4* 

C 

c*** HJ = NUMBER OF MASS POINTS ON BODY I 
C*»* NE = NUMBER OF ELASTIC MODES RETAINED FOR BODY I 
NE = IRGFLXfNBOD) 

NE6 ^ NE •*• 6 
C 

C*** RFAO FORMA TAPE OR CARDS - CREATE NTAPE2 
C 

C MASSES 

CALL READ (A,Nl,N2,KJOINT,KMODEI 
NJ = N1 
DO 2 I = lfNJ 

IFIA(Itl) .LT. ZRO) GO TO 995 
2 CONTINUE 

WRITE(NTAPE2 » ( Ad tl ) 1 1=1 tNJ) 

C 

C INERTIAS 

CALL READ (A,Nl,Nt2,KJCINT,KMODE) 

IF(N1 ,NE. NJ .OR. N2 .NE. 61 GO TO 999 
WR ITHNTAPE2) d A II , J » , J=l, 6| 1 1=1 1 NJ » 

C 

C STATIC MOMENTS - GEOMETRIC COORDINATES 

DO 5 K*lt2 

CALL READ f A ,Nl ,N2 ,K JOINT f KMODE ) 

IF(Nl .NE. NJ .OR. N2 .NE. 3) GO TO 999 
WRITE(NTAPE2) ( ( A t I t J ) » J=1 t3) *1=1 tNJ ) 

5 CONTINUE 
C 

C MODAL AMPL ITUOES 

DO 10 K=l,6 

CALL READ «AtNl,N?,K JOINT.KMODE) 

1F(N1 .NE. NJ .OR. N2 .NE. NEI GO TO 999 
WRITE (NTAPE2) ( I A( It J) f J>lf NE ) * I-] tNJ ) 

10 CONTINUE 
C 

C STIFFNESS - DAMPING 

DO 20 K=l,2 

CALL READ lA ,N1,N2 ,K JOINTtKMODE » 

IF(N1 .NE. NE .OR. N2 .NE. NE) GO TO 999 
WP ITE(NTAPE2 ) ( I A ( I» J ) f J=1 fNE ) y 1*1 yNE ) 

20 CONTINUE 
C 

DO 47 1=^1, NJ 
47 UVECd) = ONF 
C 

REWIND NTAPE2 
NREC2 = 0 
C 

C*** CREATE NTAPE3 
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004795 

004796 

004797 

004798 

004799 

004800 

004801 

004802 

004803 

004804 

004805 

004806 

004807 

004808 

004809 

004810 

004811 

004812 



J 


I 




125 



CALL C8ET3 (NREC2tNJ»NE«AfB,WStKAtKB*KWS) 

004813 

c 


004814 


REWIND NTAPE3 

004815 


NREC3 = 0 

004816 

c 


004817 

c*** 

FORM MU2ERO MATRIX 

004818 


CALL ZER0CAMU»NE6fNE6tKAMU) 

004819 

c 


004820 


call CREMUO(NREC3»NJtUVECfA»WS«AMU»KAfKWS»KAHU) 

004821 

c 


004822 

c*** 

FORM AO AND DO COEFFICIENTS 

004823 


CALL CREADOfNREC3*NJyNE*UVECtA»BtCvWS»AMUyKA»KBtKC,KHSt 

KAMU) 004824 

c 


004825 

€♦♦♦ 

FORM E COEFFICIENTS 

004826 


CALL CREE INREC3yNREC2yNJyNEyAyByCyAMUyKAyKByKCyKAMU) 

004827 

c 


004628 


SYMMETRIZE AMU 

004829 


DO 48 1=1, NF6 

004830 


DO 48 J=lyNE6 

004831 

48 

AMUfJyl) = AMUflyJ) 

004832 

C 


004833 


CALL WRITE f AMUyNE6,NE6y3HMU0yKAMU) 

004834 


WRITEINTAPFl) f ( AMUf I y J) y J=lyNE6) y 1=1 yNE6) 

004835 

C 


004836 

c*** 

FORM ACOF 

004837 


CALL CREA (NREC3yNJ yNE yUVECy AyByKAyKB yKWS) 

004838 

C 


004839 

c*** 

FORM PCOF 

004840 


CALL CREB (NREC3yNREC2yNJyNEyAy6yWS yKAyKByKHS ) 

004841 

c 


004842 


FORM CCOF 

004843 


CALL CREC fNREC3yNREC2yNJ,NE,AyByCy AMUyKAyKByKCyKAMUl 

0048 44 

C 


004845 

c*** 

FETCH AND STORE STIFFNESS AND DAMPING 

004 846 


CALL FETCH(NTAPE2yllyNREC2f AHUyNEyNEyKAMU) 

004847 


WRITEfNTAPEl ) ( ( AMUf I y J) y J=1 yNE ) , 1=1 yNE 1 

004848 


CALL FETCH CNTAPE2y 12 yNRECZy AHUyNEyNEyKAMU) 

004849 


WRITEINTAPFl 1 f (AMUi It J ) y J=1 yNE ) , 1 = 1 yNE 1 

004850 

c 


004851 

c*** 

READ AND STORE INITIAL CONDITIONS 

004852 


READ(NITyl002) ( A( 1 y J ) yJ=l yNE ) 

004853 


REA0(NIT,1002) t A(?y J ) y J=1 yNE) 

004854 


CALL WPITECAllyDylyNEyAHXEO yKA) 

004855 


CALL WRITE(A(2yl)ylyNEy4HXE0DyKA) 

004856 


WRTTE(NTAPFl) (A (1 y J ) y J=1 yNE) 

004857 


WR1TE(NTAPE1 ) fA(2yJ ) yJ=l yNE) 

004858 

c 


004859 

c**» 

HINGE LOOP 

004860 

c 


004861 


NHB = NHPOKNBOD) 

004862 
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WRlTE(MTAf»El) NHB 00A863 

C 004864 

00 150 L=1 tNHB 004865 

READ (NITf 1001) N0H*1 TYPE* JOINT 004866 

ISUMRYatl) = NOH 004867 

ISUHRY(L«2) = ITYPE 004868 

ISUHRY(Lf3) = JOINT 004869 

IFCNOH ,LT. 2 .OR. NOH -GT. NH) GO TO 996 004870 

LR = 6*(N0H“2) ♦ 1 004871 

LO = 7*<NOH-2) ♦ 1 004872 

IF(IT0P0LC1*N0H) .EQ. NBOD) GO TO 152 004873 

IF(IT0P0L( 2,N0H) .NE. NBOD) GO TO 996 004874 

LR = LR+1 004875 

LD = LD+1 004876 

152 CONTINUE 004877 

C . 004878 

DHllfLD) = WSf JOINT* 11) 004879 

DHC2,LD) = WSIJ0INT.12) 004880 

DHI3.LD) = WS(J0INT,13) 004881 

C 004882 

C*** READ ANGLES 004883 

READ(NIT,1002) (WV(J)*J=1»3) 004884 

ASUMRYIL*!) = WV(l) 004885 

ASUMRY(L*2) = WV(2) 004886 

ASUMRYCL.3) * WV(3) 004687 

C 004888 

CALL ROTTR f 3#ITYPE,WV*RHf l.l.LR) *DL»M,0UM) 004889 

C 004890 

C**» READ HX*HY,HZ 004891 

CALL FETCH INTAPE2* 5 *NREC2»A»NJ *NE*KA) 004892 

CALL FETCH INTAPE2* 6*NREC2*B*NJ*NE*KB) 004893 

CALL FETCH (NTAPE2s 7*NREC2*C#NJ,NE*KC) 004894 

C 004895 

DO 154 Jsl *NE 004896 

AMUIlfJ) - A I JOINT ,J) 004897 

AMlKZyJ) = B(JOINT*J) 004898 

154 AHUOfJ) = C( JOINT, J) 004899 

C 004900 

C*** READ SIGX*SIGY,SIGZ 004901 

CALL FETCH INTAPE2, 8 ,NREC2*A*NJ,NE*KA) 004902 

CALL FETCH (NTAPE2, 9*NREC2*B*NJ*NE *KB) 004903 

CALL FETCH (NTAPE2, 10, NREC2,C,NJ,NE,KC) 004904 

C 004905 

DC 155 J=1 ,NE 004906 

AMUI4,J) =Af JOINT, J) 004907 

AMUf5,J) = B( JOINT, J) 004908 

155 AHUIbyJ) = C C JOINT, J) 004909 

C 004910 

WRITFINTAPEl ) NOH 004911 

HRITE(NTAPEl) ((AMUC I,J),Jsl,NE),Isl ,3) 004912 
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WHITE(NTAPEl) (I AMU(I»J}»J«l»NE)tIs4t6) 

004913 

c 


004914 

ISO 

CONTINUE 

004915 


WRITE (N0T»3022) NBOO 

004916 


CALL WRITIS (ISUHRYfNHBf3,KSUMRY» 

004917 


CALL WRITES ( ASUMRY»NHBt3»KSUMRY) 

004918 

c 


004919 

c*** 

SENSOR LOOP * ♦♦ ♦♦♦»»»♦»♦♦♦»♦♦ ♦♦♦♦♦♦♦»» »♦♦♦♦♦ 

004920 

c 


004921 


NSB = NSPOKNBODI 

004922 


WRlTEtNTAPEll NSB 

004923 


IFINSB .EQ. 01 RETURN 

004924 

c 


004925 


DO 160 L=1*NSB 

004926 


READ(NIT,1001 » NOS 1 1 TYPE, JOINT 

004927 


ISUMPY(L,1) = NOS 

004928 


ISUMRY(L,2) = ITYPE 

004929 


ISUMRYCL,3» = JOINT 

004930 


IFUFTSHWINOS) .NE. NBOD) GO TP 996 

004931 


LR - 2*N0S - 1 

004932 


0S(1,LR) = WSIJOINT.llI 

004933 


DS(2,LR) = WS( JOINT, 12) 

004934 


0S(3,LP.) = WS( JOINT, 13) 

004935 

c 


004936 

c*** 

READ ANGLES 

004937 


REAO(NIT,1002) (WV(J),J=1,3) 

004938 


ASUMRY(L,1) = WVm 

004939 


ASUMRY(L,2) = WV(2) 

004940 


ASUMRY<L,3) = WV(3) 

004941 

c 


004942 


CALL ROTTR (3, ITYPE,WV,RS t 1,1 ,LR) ,0UM,DUM ) 

004943 

c 


004944 

c*** 

READ HX,HY,HZ 

004945 


CALL FETCH INTAPE2, 5 ,NREC2,A,NJ,NE.,KA) 

004946 


CALL FFTCH(NTAPE2, 6 ,NREC2,B,NJ ,NE ,KB ) 

004947 


CALL FETCH (NTAPE2, 7,NREC2,C,NJ,NE,KC ) 

004948 

c 


004949 


DO 164 J-1 ,NE 

004950 


AMU(l.J) = A(J01NT,J) 

004951 


AMUC2.J) = P(JOINT,J) 

004952 

164 

AMLI(3tJ) = C ( JOINT, J) 

004953 

c 


004954 

c*** 

READ S1GX,SIGY,SIG2 

004955 


CALL FETCH(NTAPE2, 8 ,NREC2,A,NJ,NE,KA) 

004956 


CALL FETCH (NTAPE2, 9,NREC2,B,NJ,NE,KB) 

004957 


CALL FETCH «NTAPE2, 10, NREC2,C,NJ,NE,KC ) 

004958 

c 


004959 


00 165 J=1,NE 

004960 


AMU(4,J) s A ( JOINT, J) 

C04961 


AMU(5,J) = B(JOINT,J) 

004962 
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165 AHUf6tJI = C(JOlNTtJ) 004963 

C 004964 

WRITECNTAPEI » NOS 004965 

WRITEfNTAPEl I I f AMU( I t J) t J=1 «NE1 t 1^1 t3 } 004966 

WRITE(NTAPFl) f ( AMU( It Jit Jsl»NE)t Is4t6) 004967 

C 004968 

160 CONTINUE 004969 

WRITE (N0Tt3023) NBOO 004970 

CALL MPITIS (ISUMRYtNSBt3tKSUMRY) 004971 

CALL WRITES (ASUMRY»NS6 t3 tKSUMRY) 004972 

C 004973 

RETURN 004974 

C 004975 

995 WRITF(N0Tt2001) 004976 

2001 FORMATCIHI t45HNEGATIVE OR ZERO LUMPED MASSt PROGRAM STOPPEOI 004977 

STOP 004978 

996 WRITECN0Tt2003) 004979 

2003 FORMAT ( IHl ,31HT0PCL0GY ERRORt PROGRAM STOPPED! 004980 

STOP 004981 

999 WRITE (NOT, 2004) 004982 

2004 F0RMATC1H1,41HERRCR IN INPUT TO MSMODLt PROGRAM STOPPEOI 004983 

STOP 004984 

C 004985 

END 004986 


[HOGtP MULTA 
[FOR, IS MULTA 

COMPILER (XM=ll,(EOUIV=CMN) 

SUPROUTINE MULTA f AZ,b,NRA,NRB,NCB,KAZ,Ke) 
IMPLICIT DOUBLE PRECISIONCA-H,0-Z) 
DIMENSION AZ(KAZtl), B(K6,l)fW(150) 

DATA NOT / 6/ 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


MATRIX MULTIPLICATION. A ♦ B = Z. 

USES TWO WORK SPACES. RESULT (Z» IS PLACED IN A. 

AZ MUST BE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
LARGER OF A OR Z. 

CALLS FORMA SUBROUTINE ZZBOMB. 

THE MAXIMUM SIZE IS 
NRB = XXX 

DEVELOPED BY C S BODLEY. JANUARY 1965. 

LAST REVISION BY R F HRUDA. JUNE 1972. 


SUBROUTINE ARGUMENTS 
AZ = INPUT MATRIX. SIZE ( NRA,NRB ) . 

= OUTPUT RESULT MATRIX. SIZE (NRA«NCB I . 

B = INPUT MATRIX. SI ZE (NRB,NCB ) 

NRA = INPUT NUMBER OF ROWS OF MATRICES A,Z. 

NRB = INPUT NUMBER OF ROWS OF MATRIX B, COLS OF MATRIX A. MAX=500, 
NCP = INPUT NUMBER OF COLS OF MATRICES B,Z. 

KAZ = INPUT ROW DIMENSION OF AZ IN CALLING >$?OGRAM. 

KB s: INPUT ROW DIMENSION OF B IN CALLING PROGRAM. 


IF (NRB .GT. 150) GO TO 999 


\ 


00 40 1=1, NR A 
DO 20 K=1,NRB 
20 W(K) = AZ(I,K) 

DO 40 J=1,NCB 
S = O.D O 
00 30 K=1,NRB 
30 S = S ♦ W(K)*B(K,J) 
40 AZ(I,J) = S 
RETURN 


C 


999 WRITE (NOT, 1001) 

1001 FORMAT (1H1,31HERR0R IN MULTA, 
STOP 
END 


PROGRAM STOPPED) 


-004987 

-004988 

-004989 

004990 

-004991 

7004992 

004993 

004994 

004995 

004996 

004997 

004998 

004999 

005000 

005001 

005002 

005003 

005004 

005005 

005006 

005007 

005008 

005009 

005010 

005011 

005012 

005013 

005014 

7105015 

005016 

005017 

005018 

005019 

005020 

005021 

005022 

005023 

005024 

005025 

005026 

005027 

005028 

005029 

005030 


oononnonooonooononn 



130 


tHDGfP MULTB 
[FOR, IS MULTB 

COMPILER [XN=^n,(EOUIV=CMN} 

SUBROUTINE MULTB (A,BZ,NRA,NRB,NCB,KA,KBZ } 

IMPLICIT DOUBLE PRECISI0NIA-M,0-ZI 
DIMENSION A(KA,n,BZ(KBZ,l) 

COMMON /LWRKVl/ W( 501 

MATRIX MULTIPLICATION. A ♦ B = Z. 

USES TWO WORK SPACES. RESULT (Zl IS PLACED IN B. 

BZ MUST BE DIMENSIONED LARGE ENOUGH IN MAIN PROGRAM TO CONTAIN THE 
LARGER OF B OR Z. 

THE MAXIMUM SIZE IS 
NRB = 500. 

SUBROUTINE ARGUMENT DESCRIPTIONS 

A = INPUT MATRIX. SIZE (NRA,NRBI. 

BZ = INPUT MATRIX. SIZE (NRB,NCBI. 

= OUTPUT RESULT MATRIX. SIZE (NRA,NCB) . 

NRA = INPUT NUMBER OF ROWS OF MATRICES A,Z. 

NRB = INPUT NUMBER OF ROWS OF MATRIX B, COLS OF MATRIX A. MAX 

NCB = INPUT NUMBER OF COLS OF MATRICES B,Z. 

KA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

KBZ = INPUT ROW DIMENSION OF BZ IN CALLING PROGRAM. 

DO 40 J=1,NCB 

DO 20 K=l,NRB 

20 W(K) = BZ(K,J) 

DO 40 1=1, NR A 
S = 0.00 
DO 30 K=1,NRB 
30 S = S + A( I,K)RWIK) 

40 BZII,JI = S 

RETURN 
END 


-005031 

-005032 

-005033 

005034 

-005035 

005036 

48005037 

005038 

005039 

005040 

005041 

005042 

005043 

005044 

005045 

005046 

005047 

005048 

005049 

005050 

005051 

005052 

005053 

005054 

005055 

005056 

005057 

005058 

005059 

005060 

005061 

005062 

005063 

005064 

005065 

005066 

005067 
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[HDG.P MULT3 -005068 

IFOR ,1s MULT3 -005069 

COMPILER (XM=1),IEQUIV=CMN) -005070 

SUBROUTINE MULT3I AtBtZ»NRA,NRBfNCBtKRAtKPB.KR2 ) 005071 

IMPLICIT DOUBLE PRECISION! A-H.C-ZI -005072 

DIMENSION AIKRAtUtBfKKBtl)tZ(KRZtl)tWRflOO) 8405073 

C 005074 

no 20 1=1, NR A 005075 

DO 15 J=1,NRB 005076 

15 WR(J) = AC1,JI 005077 

DO 20 J=1,NCE CC5078 

S = 0.0 0 005079 

DO 30 K=1,NRB 005080 

30 S = S + WR(K|*BCK,J) 005081 

20 Z(I,J) = S 005082 

C 005083 

RETURN 005084 

END 005085 


1 
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[HOG»P MUITAD -005086 

tFORflS HULTAO -005087 

COMPILER (XMsl)t(FQUIVsCMN) -005066 

SU6RCUTINE MULTAD (A«BtZ»NRAtNRetNr.BtKRAtKRBtKRZ) 005069 

IMPLICIT DOUBLE PRECISION(A-M,n-ZI -005090 

DIMENSION A(KRA»n*B(KRBtl)tZIKRZ»l)»WR(100) 8505091 

C 005092 

DO 20 I^ltNRA 005093 

DO 15 J=lfNRB 005094 

15 WRCJ) = AC1,J) 005095 

DO 20 J*1,NCB 005096 

S = 0-D 0 005097 

DO 30 K=1,NRB 005098 

30 S = S ♦ WR(K»*B|K,J» 005099 

20 ZfI,J) =: ZtJfJt * S 005100 

C 005101 

RETURN 005102 

END 005103 



or>ooooor»oooo 
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{HD&,P NIPLOT 
t FOR, IS NIPLOT 

COMPILER C XM=n,IECUIV»CMN) 

SUPROUTIME NIPLOT H ITLE,OBMIM,OBMAXI 


*** 

*** MSEC UNIVAC J108 VERSION ♦♦♦ 

SUBROUTINE FORMS NICHOLS PLOT 

SUBROUTINE ARGUMENT DESCRIPTIONS 

TITLE = INPUT ALPHA NUMERIC TITLE 
OBMIN = INPUT LOWER OP LIMIT TO PLOT 
DBMAX = INPUT UPPER DB LIMIT TO PLOT 

COMMON /LSTART/ IRUNNO, IDATE, NPAGE 
COMMON /PS TUFF/ 

* SAVEO(SOO), SAVEPfSOO), SAVEDfSOOl, SAVEAfSOOl, KSAVE 

COMMON /AOOPLT/ X(5CO),Y(5OO),DUMMYf5O0!l 
C 

DIMENS ION TITLEfl » ,TX 1 12 ) ,TYC 12 » 

C 

EOUI VALENCE I IRUNNO,RUNNO ) 

C 

TXC 1) = 6H 
DO 5 1=1,10 
5 TXll+U = TlTLE(l) 


TXC12I 

S 

6H 


TY( 

1) 

= 

6HNICH0L 

TYC 

2) 

s 

6HS PLOT 

TY( 

3> 

St 

6H 


TYC 

4) 

S 

6HAMP 

RA 

TYC 

5) 

E* 

6HTIC 

IN 

TYC 

6> 

S 

6H DB 

VS 

TYC 

7) 

tr 

6M PHASE 

TYC 

8) 

c 

6H IN 

OE 

TYC 

9) 

sr 

6HG 


TYCIOI 

s: 

6H 


TYCllI 

sr 

6H 


TYC12I 

sr 

RUNNO 



C 

CALL PLOTS SCOBMAX, OBMIN, YTOPfYBOT I 
C 

XLFT =0.0 
XRGT = 360. 

C 

IFR = 0 
IFL = 0 


-005104 
-005105 
-005106 
-005 107 
-005108 
-005109 
-005110 
-005111 
-005112 
-005113 
-005114 
-005115 
-005116 
-005117 
-005118 
-005119 
-005120 
-005121 
-005122 
-005123 
-005124 
-005125 
-005126 
-005127 
-005128 
-005129 
-005130 
-005131 
-005132 
-005133 
-005134 
-005135 
-005136 
-005137 
-005138 
-005139 
-005140 
-005141 
-005142 
-005143 
—005144 
-005145 
-005146 
-005147 
-005148 
-005149 
-005150 
-005151 
-005152 
-005153 


t 
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KNT = 0 

DO 80 I=1»KSAVF 
OB = SAVFDCn 
PH = SAVEP(I) 

IFID6 .GE. DBMIN .AND. DB .LE. 06NAXI GO TO 81 
IFCIFL .EG. Cl GO TO 80 

75 IFIIFR .EG. O) CALL GUIK3L(-1,XLFT,XRGT, 

♦ VBOT,YTOP,35,TX,TY,-KNT,X,Y) 

IFflFR .EG. 1) CALL 0UIK3L( 0»XLFTtXRGT» 

♦ VB0T,YT0P,35.TX.TY,-KNT,XtVI 
IFL = 0 

IFR = 1 
KNT 0 
GO 70 80 
81 KNT = KNT ♦ 1 
X(KNT) = PM 
Y(KNT) -- OP 
IFL = I 

IFfI .FG. KSAVEI GO TO 75 
60 CONTINUE 

RETURN 

END 


-005154 

-005155 

-005156 

-005157 

-005158 

-005159 

-005160 

-005161 

-005162 

-005163 

-005164 

-005165 

-005166 

-005167 

-005168 

-005169 

-005170 

-005171 

-005172 

-005173 

-005174 

-005175 

-005176 


ooooo n onooor>or>oor>onoonnrio r> oooo 
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[HDGfP NUMS 
t FOR f I S NU«S 

COMPILFR ( XM=1I» IECUIV=CMN1 

SUBROUTINE NUMS IA#DtBtRlRfRl IfR2R#R21,PTCL» 

♦ GAIN,1FLG,NN,NZR0,IY,NA,KAI 
C 

IMPLICIT DOUBLE PRECISION C A-HtO-Z I 

SUBROUTINE DETERMINES NUM(SI 
CALLS OR PACKAGE 

COMMON /OR AT 10/ 

♦ IFL1» lFL2t0RVEC(l50l 

DIMENSION A(KA«l)»En )•RlB(l}tRlImtR2Rm «R2mi 
DIMENSION OIK A, II 

SUBROUTINE ARGUMENT DESCRIPTIONS 

A = INPUT TRANSFORMED PARTIAL DERIVATIVE MATRIX. NA.NA 

e = INPUT COEFF. OF INPUT TF FOR QIOUTI/Of INI . NAtl 

RIR = OUTPUT REAL ROOTS OF FIRST TERM IN NUNFRATOR. NA-1 

Rll « OUTPUT IMAGINARY ROOTS OF FIRST TERM IN NUMERATOR. 

R2R = OUTPUT REAL ROOTS OF SECOND TERM IN NUMERATOR. NA-1 

R21 = IMAGINARY ROOTS OF SECOND TERM IN NUMERATOR. 

FOR INVERSE SHIFT. 

PTOL = INPUT TOLERANCE TO REMOME THE P(II » 0 ROOTS 
GAIN = OUTPUT GAIN OF NUMERATOR. 

NN = OUTPUT NUMBER OF NUMERATOR TERMS. EITHER 1 OR 2. 

lY = INPUT COL LOCATION OF DESIRED 01 OUT) — LOCAL— 

KA = INPUT ROW DIMENSION SIZE OF A IN CALLING PROGRAM. 

IFLG = FLAG TO SET FOR ZERO GAIN. 

= 0 ZERO GAIN DETECTED. 

=1 GAIN NOT ZERO. 

CON = -DS0RTf3.D0) 

IF LI - 1 
IFL2 = 0 
IFLG 1 

FORM AUGMENTED A MATRIX 

REPLACE COL lY OF A WITH COL NA OF A AND 
PUT B INTO COL NA OF A 

DO 10 I=lfNA 
ACI*1Y) = A(t»NA) 

10 A(i«NA) = -em 
C interchange row IY of a with row NA OF A 
DO 15 JslvNA 


-005177 

-005178 

-005179 

005180 

005181 

005182 

-005183 

005189 ^ 

005185 

005186 

005187 

005188 

10005189 

005190 

005191 

005192 

005193 

005194 

005195 

005196 

005197 

005198 

005199 

005200 

005201 

005202 

005203 

005204 

005205 

005206 

005207 

005208 

005209 

005210 

005211 

005212 

005213 

005214 

005215 

005216 

005217 

005218 

005219 

005220 

005221 

005222 

005223 

005224 

005225 

005226 


on n onn n non 
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Z = AflY.JI 


005227 

AlIYyJ) = A(NA»JI 


005228 

15 A(NAtJl - Z 


005229 

OBTAIN PIVOTAL ELE AND CK FOR ZERO 


005230 

Z s A(NA»NA) 


005231 

IF (Z ,E0. 0.00) GO TO 50 


005232 

GAIN = -Z 


005233 

NN = 1 


005234 

DO 20 J=1»NA 


005235 

20 A(NAtJ) = AfNA«J) / Z 


005236 

NA2 = NA-1 


005237 

DO 30 IslfNA2 


005238 

DO 30 JsltNA 


005239 

30 A(I«J) - AfItJ) - AfltNA) P AfNAtJ) 


005240 

call write (AtNAtNA*4HANUMtKA) 


005241 

CALL ORDRVR lAtNA;»RlR»RlI»KA) 


005242 

NZRO = NA2 


005243 

GO TO 100 


005244 

50 CONTINUE 


005245 



005246 

NN = 1 


005247 

NA2 = NA-1 


005248 



005249 

FORM (A - I*CON| 


005250 



005251 

DO 55 1=1, NA2 


005252 

55 A(I,1) = Ail, I) - CON 


005253 



005254 

CALL GAUSS I CA,D,NA,KA) 


005255 

CALL WRITE IDRVEC,1,NA,6HDRATI0,1I 


05256 

IF fIFL2 .EQ. 0) GO TO 57 


005257 

IFL2 = 0 


005258 

IFL6 = 0 


005259 



005260 

ZERO GAIN ENCOUNTERED IN GAUSS I. 


005261 



005262 

RETURN 


005263 



005264 

57 CONTINUE 


005265 



005266 



005267 

GAIN = ORVECCl) 


005268 

DO 58 1=2, NA 


005269 

58 GAIN = GAIN « DRVECil) 


005270 



005271 

DO 59 1=1, NA 


005272 

59 DfI,NA) = O.DO 


005273 



005274 

CALL ORDRVR ID,NA,R2R,R2I,KA) 


005275 



005276 


onn o n n n n 
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PEMOVE THE PII) = 0. ROOTS. 005277 

005278 

CALL SIFT (R2PtNA»PT0U 005279 

CALL SIFT (R2I*NA,PT0L> 005280 

005281 

•^=0 005 282 

DO 60 1=1 tNA 005283 

IF (R2R(I) *E0. O.DO .AND. 005284 

♦ R2im .EC. 0.001 GO TO 60 005265 

K=K+1 005286 

R1R(K| = R2RI1) 005287 

RIKK) = R2K1) 005268 

60 CONTINUE 005289 

005290 

N2R0 = K 005291 

NEXP = NA-NZRO 005292 

PIP = l.DO 005293 

1=0 -005294 

00 70 III=1,NZR0 -005295 

1 = -005296 

IF (I .GT. NZRO) GO TO 71 -005297 

IF «Rlim .EQ. 0.001 GO TO 65 -005298 

PIP = PIP » (R1R(I)**2 ♦ Rlim**2) -005299 

I=I-»1 -005300 

GO TO 70 -005301 

65 PIP = PIP ♦ RlRm -005302 

70 CONTINUE -005303 

71 CONTINUE -005304 

005305 

GAIN = GAIN ♦ PIP 005306 

IF (NEXP .EC. 0) GO TO 75 005307 

00 72 I=1,NEXP 005308 

72 GAIN = — 1.00*GAIN 005309 

75 CONTINUE 005310 

' 005 311. 

PEHOVE THE SHIFT VALUE TO OBTAIN TRUE ROOTS. 005312 

005313 

00 80 1= It NZRO 005314 

RMOO = R1R(I)**2 ♦ RlI(n*P2 005315 

RlPm = R1R(II/RM00 ♦ CON 005316 

80 RlKIl = -Rlim/RMOO 005317 

C 005318 

100 CONTINUE 005319 

RETURN 005320 

END 005321 


uuuuuuuouuuu 
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(HDG«P NYPLOT 
f FOR* IS NYPLOT 

COMPILER f XH=1),CEQUIV=CHNI 
SUBROUTINE NYPLOT (TITLE* AMIN ,AMAX) 


*** 

MSEC UNIVAC 1108 VERSION 

SUBROUTINE FORMS NYQUIST PLOT 

SUBROUTINE ARGUMENT DESCRIPTIONS 

TITLE = INPUT ALPHA NUMERIC TITLE 
AMIN = MINIMUM AMPLITUDE TO PLOT 
AMAX « MAXIMUM AMPLITUDE TO PLOT 

COMMON /LSTART/ IRUNNO, I DATE* NPAGE 
COMMON /PS TUFF/ 

♦ SAVE0(500I* SAVEP(SOO)* SAVEDfSOOl* SAVEA(500I* KSAVE 

COMMON /ADDPLT/ X{500»*Y(500)*0UMMV|500I 
C 

DIMENSION TITLEm,TXfl2l*TYfl2) 

C 

EQUIVALENCE ( IRUNNO* RUNNO ) 

C 

TX( II = 6H 
DO 5 1=1*10 
5 TXfI+ll = TITLEIII 
TX(12) = 6H 
C 

TY( II = 6HNY0UIS 
TY( 21 = 6MT PLOT 
TY( 31 = 6H 
TYC Al = 6HAMPLIT 
TY (51 = 6HUDE - 
TY( 61 = 6HIMAG P 
TY( 71 = 6HART VS 
TY( 81 = 6H REAL 
TYC 91 = 6HPART - 
TYCIOI = 6H 
TYdll = 6H 
TY(12I = RUNNO 
C 

CALL PLOTS S ( AMAX *-AMAX * YTOP *YBOT| 

CALL PLOTSS(AMAX*-AMAX,XRGT*XLFTI 

C 

IFR = 0 
IFL = 0 
KNT = 0 

DO 80 1=1* KSAVE 


-005322 

-005323 

-005324 

-005325 

-005326 

-005327 

-005328 

-005329 

-005330 

-005331 

-005332 

-005333 

-005334 

-005335 

-005336 

-005337 

-005338 

-005339 

-005340 

-005341 

-005342 

-005343 

-005344 

-005345 

-005346 

-005347 

-005348 

-005349 

-005350 

-005351 

-005352 

-005353 

-005354 

-005355 

-005356 

-005357 

-005358 

-005359 

-005360 

-005361 

-005362 

-005363 

-005364 

-005365 

-005366 

-005367 

-005368 

-005369 

-005370 

-005371 
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R = SAVEA(I) 

T = SAVEPC 11/57.2958 

IFIR .GE. AMIN .AND. R .LE. AMAXI 60 TO 81 
IFIIFL .EO. 0) GO TO 80 

75 IFUER .EO. 0) CALL 0UIK3L(-lt XLFT,XRGT, 

* VB0T.YT0P,35tTX,TY*-KNT,XfY) 

IFtlFR .EO. 1) CALL 0UIK3LC 0,XLFTtXRGT, 

* YPOT,YTOP,35tTX,TY,-KNT,XtY ) 

IFL = 0 

IFR = 1 
KNT * 0 
GO TO CO 
81 KNT = KNT + 1 

XIKNTl = R*COSCTI 
VIKNTI = RYSlNfT) 

IFL = 1 

IFir .EO. KSAVEl GO TO 75 
80 CONTINUE 

RETURN 

END 


-005372 
-005373 
-005374 
-005375 
-005376 
-005377 
-005378 
-005379 
-005380 
-005381 
-005382 
-005383 
-005384 
-005385 
-005386 
-005387 
-005388 
-005 3C9 
-005390 
-005391 
-005392 


140 


tHOGtP PAGEHO 
r FOR, IS PAGFHD 

COMPILER (XM=1), IEOUIV=CHN) 

SUBROUTINE PAGEHD 
C 
C 

C »♦* MSFC UNIVAC 1108 VERSION 
C ♦♦♦ 

COMMON /LSTART/ IRUNNO, IDATE, NPAGE 
COMMON /LSTRTl/ UNAME('3), TITLEK12), TITLE?(12I 
C 

EQUIVALENCE (IDATE, DATE) 

C 

DATA NOT / 6 / 

C 

2001 F0RMAT(9H1RUN NO. A6 , 42X 5HDATE A6, 42X 9HPAGE NO. 14, 

* /55X 7HRUN BY 3A6, // lOX 12A6, lOX 15HCURRENT TIME = ,A6 

» /lOX 12A6, lOX 16HTHE CPU TIMER = ,I4,4H SEC) 

C 

CALL SCLOCK( DATE ,TIME,ESEC,E60SEC ) 

CALL CPUTIM(ISEC) 

ISEC = ISEC/1000000 
NPAGE = NPAGE ♦ 1 

WRITE (NOT, 2001 ) IRUNNO, DATE , NPAGE ,UNAME,TITLE1 , TIME ,TITLE2, ISEC 
C 

RETURN 

END 


-005393 

-005394 

-005395 

-005396 

-005397 

-005398 

-005399 

-005400 

-005401 

-005402 

-005403 

-005404 

-005405 

-005406 

-005407 

-005408 

-005409 

-005410 

-005411 

-005412 

-005413 

-005414 

-005415 

-005416 

-005417 

-005418 

-005419 



uuoouuououuuou 
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IHDG.P PLOTSS 
IFOR, IS PLPTSS 

COMPILER ( XM=1 I, (EOUIV=CMNI 

SUBROUTINE PLOTSS (YMAXIN,YHININf VTOP.YBOT) 

♦♦♦ MSEC UNIVAC 1108 VERSION ♦♦♦ 

♦♦♦ 

SUBROUTINE SELECTS PLOT UPPER AND LOWER LIMITS FOR A 10 SQUARE 
LINEAR PLOT GRID. 


SUBROUTINE ARGUMENT DESCRIPTIONS- 

YMAXIN = INPUT MAXIMUM VALUE TO BE PLOTTED. 
YMININ = INPUT MINIMUM VALUE TO BE PLOTTED. 

YTOP = OUTPUT UPPER GRID LIMIT. 

YBOT = OUTPUT LOWER GRID LIMIT. 

DATA NOT/ 6 / 

YMAX = YMAXIN 
YMIN = YMININ 

IF lYMAX .LT. YMIN) GO TO 999 

IF (YMAX .GT. YMINI GO TO 21 

11 IF (YMAX .LT. 0.00) GO TO 13 

YMAX = 1.0014YMAX 
YMIN = 0.999YYMIN 
GO TO 15 

13 YMAX = 0.999*YMAX 
YMIN = 1.001*YM1N 
15 IF (YMAX .NE. 0.0) GO TO 21 
YMAX = +.3 
YMIN = -.3 

21 VALUE = (YMAX-YMIN)/10. 

IF (VALUE .LT. ABS (YHlN/100000. ) ) GO TO 11 
DO 23 1=1,66 

DO 23 J=l,3 

SCALE = 2.**(J-2) ♦ 10. ♦♦(1-33) 

IF (SCALE .GE. VALUE) GO TO 31 
23 CONTINUE 

GO TO 999 

31 NSTEPS = YMIN/SCALE 

YBOT = FLOAT(NSTEPS)*SCALE 

32 IF (YMIN) 34,38,36 

33 YBOT = YBOT-SCALE 

34 IF (YBOT .LE. YMIN) GO TO 38 
GO TO 33 


NERROR = 1 


NERROR = 2 


-005420 

-005421 

-005422 

-005423 

-005424 

-005425 

-005426 

-005427 

-005428 

-005429 

-005430 

-005431 

-005432 

-005433 

-005434 

-005435 

-005436 

-005437 

-005438 

-005439 

-005440 

-005441 

-005442 

-005443 

-005444 

-005445 

-005446 

-005447 

-005448 

-005449 

-005450 

-005451 

-005452 

-005453 

-005454 

-005455 

-005456 

-005457 

-005458 

-005459 

-005460 

-005461 

-005462 

-005463 

-005464 

-005465 

-005466 

-005467 

-005468 

-005469 


35 YBOT s YBOT+SCALE 

36 IF lYBPT-YMINI 35»38t37 

37 YBOT = YBOT-SCALE 

38 YTOP * YB0T*10.*SCALE 

IF (YTOP ,GE. YMAX» RETURN 
IF (J .LT. 31 GO TO 39 
J s O 
1 = I + l 

39 J - J+1 

SCALE = 2.**(J~2) ♦ 10. ♦♦(1-331 
GO TO 32 

999 WRITE (NOT ,2001 1 NERROR 

2001 FORMAT (5X,99HERR0R ENCOUNTERED IN SUBROUTINE PLOTSS, NERROR 
♦ /#5X, 16HPR0GRAM STOPPED. I 

STOP 
END 


-005470 
-005471 
-005472 
-005473 
-005474 
-005475 
-005476 
-005477 
-005478 
-005479 
-005480 
-005481 
-005482 
13, -005483 
-005484 
-005485 
-005486 


o r» n o o 
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tHOG,P PLOTHR 
{FOR, IS PLOTWR 

COMPILER C XM=n, IEOUIV=CMN) 

SUBROUTINE PLOTWR 

IMPLICIT DOUBLE PREC IS ION ( A-H ,0-Z ) 

SUBROUTINE TO WRITE PLOT OUTPUT TAPE 

COMMON /LAMBDA/ 

♦ ALAMC30) 

COMMON /MAXHUM/ 

♦ NBMAX ,NHMAX,NSPMAX,NMWMAX ,NMWBODtNMDBOD,KHU,KY,KU 
COMMON /MOMENG/ 

♦ PI 65 l,PM0MC30l ,HTOT|3l,TOTLI3),ENGKE( 5),ENGPFt 5)t 

♦ TOTKE, TOTPE, TOTENG, AHTOT,ATOTL 
COMMON /PLTDTA/ 

♦ NPPL0T,NCPLO7 
COMMON /SPECIF/ 

♦ BETAHI6, 5),BETAHD(6, 5),AM0(?, 5) ,RHf 3t.3,?4 ) ,RS 1 3,3f ?0 ) , 

♦ DH(3,?8 ),0S(3,20},IM0l3t 5),NMOW(5, 5) ,IFTSMW(10) , 

♦ NB,NH,NSPT,NOFMO,NOELTA,ITOPOLI2f 5>,IRGFLXI 5)tIHDATAI7, 51, 

♦ LOCUl 12),LENUtl2) »NU,NBETA ,NLAM,NEO 
COMMON /TAPENO/ 

♦ NTAPE1,NTAPE2,NTAPE3 
COMMON /TIMESS/ 

♦ STARTT,OELTAT,T,ENDT,TMST 
COMMON /VECTOR/ 

♦ VI25O»,YOTI250) 


DATA 1 1ST / O / 

IF HIST .EO. 1) GO TO 5 

REWIND NTAPE3 

NR PLOT = 0 

JR = 6*NB 

IlST =1 

NLAMO = NLAM 

IF I NLAM .EO. 01 NLAMD = 1 
NCPLOT = l+2*NEQ+NLAH0+NU+JR+3+3+2*NB+5 
5 NR PLOT = NRPLOT + 1 
C 

WRITE CNTAPE3) T 

♦ , (Yf J),J=1,NE0I, lYDTC J),J=1,NEQ» 

♦ , lALAMf J) ,JH, NLAMD) , I P I J ) , J-1 , NU) 

» , (PM0M(J),J-1,JR), <HT0T(J),J*1,3) 

♦ • IT0TL(J),J=1 ,3), (ENGKEIJ),JsI ,NB) 

» , (ENGPEfJ),J=I,NB), AHTOT,ATOTL, TOTKE, TOTPE, TOTENG 

C 

RETURN 

B5D 


-005487 
-005488 
-005489 
005490 
-005491 
005492 
005493 
005494 
005495 
1005496 
005497 
005498 
005499 
1105500 
005501 
005502 
005503 
005504 
1605505 
1705 506 
1805507 
1905508 
005509 
005510 
005511 
005512 
005513 
2005514 
005515 
005516 
005517 
005518 
005519 
005520 
005521 
005522 
005523 
005524 
005525 
005526 
005527 
005528 
005529 
005530 
005531 
005532 
005533 
005534 
005535 
005536 


no on 


14A 


CHDGtP PLTCAR 
CFORtlS PLTCAR 

COMPILER f XM=lltlEQUIV=CMN| 

SUBROUTINE PLTCAR IDATA,NI,ND,NR,NG. 

♦ TlTLl,TITLOtTITLP,TITLM.KR) 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 


*** 

*** MSEC UNIVAC 1108 VERSION ♦♦♦ 

*** 

DATA DATA ARRAY 

NI LOCATION OF INDEPENDENT VARIABLE fXI 

ND LOCATION OF DEPENDENT VARIABLES <Y(I),1=1,3) 

NR NO OF VALUES TO PLOT 

NG NO OF GRIDS 

TITLI TITLE FOR INDEPENDENT VARIABLE AXIS 

TITLO TITLE FOR DEPENDENT VARIABLE AXIS 

TITLP PLOT TITLE - UNIQUE TO FRAME 

TITLM PLOT TITLE - ALL FRAMES 

KR ROW DIMENSION OF DATA ARRAY IN CALLING PROGRAM 

REAL MINI»MAXI»MIND»MAXD 

COMMON /LSTART/ IRUNNO.IOATE.NPAGE 

COMMON /LSTRTl/ UNAMEOl, TITLElfl?), TITLE?fl?) 

DIMENSION DATAIKR,l),TITLP(n tTITLHfl),ND(n 
DIMENSION TIT1C12) tTITDC12»,ISYC3) 

EQUIVALENCE C IRUNNO.RUNNO ) 

DATA ISY / IHl, 1H2. 1H3 / 


FORM TITL 
TITim = TITLO 
TITK2) = 6H VS 
TITK3) = TITLI 
TITI(A^) = 6H 
DO 1 1=1,8 

1 TITI(I^4) = TITLPCI) 
DO 2 1=1,10 

2 TITDCII = TITLMdl 
TITDClll = 6H 
TITD(12» = RUNNO 


NO OF PLOTS 
NPLOTS = 0 
DO 3 1=1,3 

IF (NO in -NE. O) NPLOTS = NPLOTS+1 
3 CONTINUE 
C 


-005S37 
-005 5 3B 
-005539 
-005540 
-005541 
-005542 
-005 543 
-005544 
-005545 
-005546 
-005547 
-005548 
-005549 
-005550 
-005551 
-005552 
-005553 
-005554 
-005555 
-005556 
-005557 
-005558 
-005559 
-005560 
-005561 
-005562 
-005563 
-005564 
-005566 
-005566 
-005567 
-005568 
-005569 
-005570 
-005571 
-005572 
-005573 
-005574 
-005575 
-005576 
-005577 
-005578 
-005579 
-005580 
-005581 
-005582 
-005583 
-005584 
-005585 
-005586 


o o o no o ooo 
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C FIND MAX/M IN OF DEPENDENT VAR IABLES 

J = ND(l) 

MAXD = DATA(1,J) 

MIND = DATAd.J) 

DO 10 L=l,NPLOTS 
J = ND(L> 

DO 10 1=1, NR 

IF(DATA(I,J) .GT. MAXD) MAXD = DATA(I,J) 

1F(DATACI,J) ,LT. MIND) MIND = DATA(I,J) 

10 CONTINUE 

IFIMAXD .EO. MIND) MAXD = MIND ♦ 10.0 
CALL PLOTSSf MAXD, MIND, ,TOPD,BOTD) 

GRID LOOP 

NLFT = 1 
NDIV = NR/NG 

DO 45 11=1 ,NG 
IFIII .GT. 1) NLFT=NRGT 
NRGT = II*NDIV 
IFCII .EO. NG) NRGT=NR 
NP = NRGT - NLFI + 1 
NEWG = -1 

FIND MAX/M IN OF INDEPENDENT VARIABLE 
MAXI = DATAINLFT.NI) 

MINI = DATAfNLFT,NI) 

DO 11 I=NLFT,NRGT 

IF(DATA(I,NI) .GT. MAXI) MAXI = DATA(I,NI) 

IF(DATA(I,NI ) .LT. MINI) MINI = DATA(I,NI) 

11 CONTINUE 

IF (MAXI .EO. MINI) MAXI = MINI ♦ 10.0 

PLOT DATA 

DO 40 J=l,NPLOTS 
IS = ISY(J) 

IIP = NI 
UP = ND(J) 

IF fj .GT. 1) NEWG = 0 

CALL 0UIK3L(NEWG, MINI, MAXI, BOTO.TOPD, 35,TITI,TITD, -NP, 
* DATA{NLFT,IIP),DATA(NLFT,IJP)) 

CALL XSCLV1(DATA(NLFT,IIP),IXR,IXE) 

CALL YSCLV1(DATA(NLFT,IJP),IYR,IYE) 

CALL PRINTV(1,IS,1XR,IYR) 

CALL XSCLVI(DATA(NRGT,IIP),IXR,IXE) 

CALL YSCLV1CDATA(NRGT,IJP),IYR,IYE) 

CALL PRINTV(1,IS,IXR,1YR) 

40 CONTINUE 


-005587 

-005588 

-005589 

-005590 

-005591 

-005592 

-005593 

-005594 

-005595 

-005596 

-005597 

-005598 

-005599 

-005600 

-005601 

-005602 

-005603 

-005604 

-005605 

-005606 

-005607 

-005608 

-005609 

-005610 

-005611 

-005612 

-005613 

-005614 

-005615 

-005616 

-005617 

-005618 

-005619 

-005620 

-005621 

-005622 

-005623 

-005624 

-005625 

-005626 

-005627 

-005628 

-005629 

-005630 

-005631 

-005632 

-005633 

-005634 

-005635 

-005636 


45 CONTINUE 
RETURN 
END 


-005637 

-005638 

-005639 

-005640 


rHDGyP PR3 

-0056A1 

[FOR, IS PR3 

-0056A2 


COMPILER [ XM=l),(EOUIV=CMN) 

-005643 


SUBROUTINE PR3 ( A, B,C,W,Z ,S,NRA, NC A.NCB ,NCC ,K A,KB ,KC,KW,KZ » 

005644 


IMPLICIT DOUBLE PRFC ISION [ A~H,C-Z ) 

-005645 


DIMENSION Af KA,l),B(KB,l),CfKC,ll,WIKW,n,Z(KZ,l) 

005646 

CC 


005647 

C 

W = A*B 

005648 

CC 


005649 


DO 10 1=1, NR A 

005650 


DO 10 J=1,NCB 

005651 


WfI,J) = O.D 0 

005652 


DO 10 K = 1,NCA 

005653 


10 WfI,J) = W(I,J) t At I,K)«BIK,JI 

005654 

CC 


005655 

C 

T 

005656 

C 

z = z ♦ s*c *w 

005657 

CC 


005658 


DO 20 1=1, NCC 

005659 


DO 20 J=1,NCB 

005660 


DO 20 K=1,NRA 

005661 


20 Z(T,J) = Z(I,J) + S*C(K,I)«H(K,J) 

005662 

C 


005663 


RETURN 

005664 


END 

005665 
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(HDG,P PRNTOU 
FFORtlS PRNTOU 

COHPILFR IXM=llt(EQ01V=CMNI 
SUBROUTINE PRNTOU 

IMPLICIT DOUBLE PRECISIONCA-HtO~ZI 
REAL CTNEW,INEM»CTOLD,TOLOtCPSTEP,CPSEC 
C 

COMMON /LAMBDA/ 

♦ ALAM(301 

COMMON /MISCNO/ 

♦ NOPRNT, NOPLOT 

COMMON /MOMENG/ 

♦ Pf 6S )*PM0M(30)tHT0T(31,T0TL(31»ENGKE( 5I,ENGPE| 5), 

♦ TOTKE, TOTPEt TOTENG* AHTOT.ATOTL 

COMMON /SPECIE/ 

♦ BETAH16, 5)tBETAHDf6» 5)*AMO(2« 5) «RHI 3«3»?4 1 »RS (3»3 1 20 1 * 

♦ DHf3»28)*OS(3»20)*IMOf3» 5)*NMOWf5» 5) « lETSMWf 10 I » 

♦ NB*NH,NSPT,N0FM0,NDELTA,IT0P0LI2, 5»,IRGFLX< 5»,IHDATAI7t 51r 

♦ LOCU( 12)tLENU(12)»NUtNBETA»NLAM»NEQ 

COMMON /TIMESSV 

♦ STARTT,OELTAT,T,ENDT,TMST 

COMMON /VECTOR/ 

♦ YC250)tYDTI250) 

C 

DATA N0T*IIST / 6, 0 / 


1000 FORMAT 

1001 FORMAT 

1002 FORMAT 

1003 FORMAT 

1004 FORMAT 

1005 FORMAT 

1006 FORMAT 

1007 FORMAT 
1017 FORMAT 
1027 FORMAT 


<//10Xt24HAT SIMULATION TlMEt T = , IPOIO.4,32 (2H* J» 

C 3X,21HTHE STATE VECTOR Y = ) 

I 3X.39HTHE STATE VECTOR TIME DERIVATIVE YDT = I 
f 3X.50HTHF BETAS I EULER ANGLES* POSITION COORDINATES) ARE) 
( 3X.29HTHE BETA TIME DERIVATIVES ARE) 

I 3X,41HTHE DELTAS f CONTROL SYSTEM VARIABLES) ARE) 

C 3X,30HTHE DELTA TIME DERIVATIVES ARE) 

( 3X* 9HF0R BODY •I2«3X*18HTHE VELOCITIES ARE) 

( 3X, 9HF0R BODY * I2,3X*29HTHE CORRESPONDING MOMENTA ARE) 

C 3Xt 9HF0R BODY , 12 ,3X »25HITS CONTRIBUTION TO TOTAL* 

♦ 31H ANf^LAR AND LINEAR MOMENTUM IS) 

1008 FORMAT C 3X,48HITS CONTRIBUTION TO TOTAL KINETIC AND POTENTIAL * 

♦ 12HENERGIES IS ,3X,1P2D15.8) 

1009 FORMAT ( 3X, 9HF0R BODY , I2,3X,27HTME ELASTIC DEFLECTIONS ARE) 

I 3X,50HTHE INTERCONNECTION CONSTRAINT FORCES I LAMBDAS ) ARE) 
C 3X*36HTHE TOTAL ANGULAR MOMENTUM VECTOR IS) 

C 3X.35HTHE TOTAL LINEAR MOMENTUM VECTOR IS) 

C/3X*29HTHE TOTAL ANGULAR MOMENTUM = ,IP015.8* 

/ 3X,29HTHE TOTAL LINEAR MOMENTUM = ,1P015.8, 

/ 3X,29KTHE TOTAL KINETIC ENERGY = ,1PD15.8, 

/ 3X*29HTHE TOTAL POTENTIAL ENERGY = ,1P015.8, 

/ 3X.29HTHE TOTAL ENERGY IT ♦ V) » ,1P015.8) 


1010 FORMAT 

1011 FORMAT 

1012 FORMAT 

1013 FORMAT 
* 

* 

* 

* 

1014 FORMAT 
* 


I//35X.33HCPU TIME/STEP 
9X.1PE10.4) 


CPU TIME/REAL TIME* /38X*1PE10.4, 


“005666 
-005667 
“005668 
005669 
“005670 
005671 
005672 
005673 
1005674 
005675 
005676 
005677 
1 105678 
005679 
005680 
1605681 
1705682 
1 805663 
1905664 
005685 
005686 
005687 
2005688 
005689 
005690 
005691 
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005715 


J 


i I . j 
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C 

IF niST ,F0. 1) GC TO 5 
CTNEW = 0. 

TNEW = STaRTT 
5 CALL PAGEHD 

WRITE < NOT, 1000 I T 
WRITE (NOT, loon 
CALL WRITES (Y,1,NEQ,1) 

C 

WRITE (NOT, 1000) T 
WRITE (NOT, 1002) 

CALL WRITES (YDT ,1 ,NE0,1 ) 

C 

WRITE (NOT, 1000) T 
WRITE (NOT, 1003) 

CALL WRITES (BETAH,6,NH,6) 

C 

WRITE (NOT ,1000) I 
WRITE (NOT, 1004) 

CALL WRITES (BETAH0,6,NH,6) 

C 

IF (NOELTA .EO. 0) GO TO 10 
WRITE (NOT, 1000) T 
WRITE (NOT, 1005) 

LO = L0CU(2»NE ♦ 2) 

CALL WRITES (Y(LO) ,1,NDELTA,1) 
WRITE (NOT, 1000) T 
WRITE (NOT, 1006) 

CALL WRITES (YOT(LO) ,1 ,NDELTA, 1 ) 

C 

10 DC 20 N=1,NP 

WRITE (NOT ,1000) T 
WRITE (NOT ,1007) N 
LO = LOCU(.N) 

LE LENU(N) 

CALL WRITES (Y(LO) ,I ,LE,1 ) 

WRITE (NOT, 1017) N 

CALL WRITES (P (LO) ,I ,LE ,1 ) 

LOPM = 6*1 N-l) + I 

WRITE (NOT, 1027) N 

CALL WRITES (PMOM( LOPM) ,1 ,6 ,1 ) 

WRITE (N0T,100e) ENGKE (N) ,ENGPE(N) 

LE = LFNU(N+NB) 

IF (LE .EO. 0) GO TO 20 
LO = LOCO(N+NB) 

WRITE (NOT, 1009) N 

CALL WRITES (Y (LO) ,1 ,LE ,1 ) 

20 CONTINUE 
C 

IF (NLAM .EO. 0) GO TO 50 
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WRITE f NOT ,1000) T 
WRITE (NOTylOlO) 

CALL WRITES ( ALAMt 1,NLAM, 1 ) 

C 

50 WRITE (NOT, 1000) T 
WRITE (NOT, 1011) 

CALL WRITES (HTOT, 1,3,1) 

WRITE (NOT, 1012) 

CALL WRITES (TOTL, 1,3,1) 

C 

WRITE (NOT, 1013) AHTOT, ATOTL, TOTK E,TOTPE,TOTENG 
C 

IF (IIST .EO. 1) GO TO 100 

IlST = 1 

RETURN 

100 TOLD = TNEW 
CTOLD = CTNEW 
TNEW = T 

CALL CPUTIM(ISEC) 

CTNEW FLOAT! IS EC/1 000000) 

CPSTEP = CTNEW - CTOLD 
CPSEC = CPSTEP/(TNEW-TOLD) 

CPSTEP = CPSTEP/FLOAT(NOPRNT) 

WRITE (NOT, 1014) CPSTEP,CPSEC 
C 

RETURN 

END 


005766 
005767 
005 76S 
005769 
005770 
005771 
005772 
005773 
005774 
005775 
005776 
005777 
005778 
005779 
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005782 
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005786 
005787 
005788 
005789 
005790 
0057P1 
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tHDG,P OR? -005793 

[FOR t IS OR? -005794 

COMPILER [ XM=1>, (EOUIV=CMN) -005795 

SUBROUTINE QP? f A,N,R,S1G,D,KR ) 005796 

C SUBROUTINE TO BE USED BV QPCON 005797 

IMPLICIT DOUBLE PREC ISION I A-H.0-2 I -005798 

DIMENSION ACKR.l ),G[31 ,PSI(?) 005799 

N1 = N - 1 005800 

lA = N - 2 005801 

IP = lA 005802 

IFCN-3) 450, lAO, 100 005803 

100 DO 130 J = 3,N1 005804 

J1 = N - J 005805 

IFC0ABSCAIJ1+1,J1I)-D> 140, 140, 110 005806 

110 DEN = AfJl-»l,Jl-M)«CAf Jl4^1, J1-^1)-~SIG)4A (Jl-M,Jl-»?}*Af J1^2,Jl-i-ll+R 005S07 

IF [DENI 120, 130, 120 OOStOS 

120 IF(DABStAr J1+1,J1I*A(J1+2,J1+1)*(DABS(A[J1+1, Jl+1 )+A< J1+2,J1+2I 005809 

l-SIGl+DAPS CArJl*3,Jl+2m/DENl-DI 140, 140, 130 005810 

130 TP=J1 005811 

140 DO 150 J=1,1P 005812 

J1=IP-J+1 005813 

IF (DABSfA IJ1+1,J] )1-D) 160, 160, 150 005814 

150 IQ=J1 005815 

160 DO 440 1=1P,N1 005816 

IFCI-IP) 180, 170, 180 005817 

170 Gm=^A(IP,IP)*(AIIP,lP)-SIG>+A(IP,IP+l)*ACIP^l,IPl+R 005818 

Gf 2)=A<IP+l,IP)»CAfIP,IP)+ACIP+l,IP+l)-SIG) 005819 

G(3)=A(IP+1,IP1*A[IP+2,IP+1) 005820 

A(IP+2,IPI=0.D0 005821 

GO TO 210 005822 

180 Gl 1 )=AI I ,1— 1 ) 005623 

G(2)=A(I^1,I-1> 005824 

IFII-IAI 190, 190, 200 005825 

190 G(3)=A[I+2,I-n 005826 

GO TO 210 005827 

200 G( 31=0. DO 005828 

210 XK=OSORTIGm*Gm+G[?.»*G(21+G[31*G(3n 005829 

TF«G(11.LT.0.0D0I XK=-XK 005830 

220 IF(XK) 230, 240, 230 005831 

230 AL=G(11/XK+1.D0 005832 

PSim=Gf21/(G(l)+XK) 005833 

PSI(2)=Gr3l/(Gm+XK) 005834 

GO TO 250 005835 

240 AL=2.00 005836 

PSI(1)=0-D0 005837 

PSI(2)=0.D0 005838 

250 IF(l-IO) 260, 290, 260 005839 

260 IFII-IPI 280, 270, 280 005840 

270 Af 1,1-1 )=-An,I-l) 005841 

GO TO 290 005842 


4 


280 A(1,I-1)=-XK 
290 DO 3A0 J=I,N 

IFfl-lA) 300, 300, 310 
300 C=PSI(2)*A (I+2,J) 

GO TO 320 
310 C=0.00 

320 E=AL=MA(I,J)+PSm )*A(I-»^1 , J }-»C ) 
A(I,J)=A(I,J)-E 
ACI-H,J)=A«I+l,J)-PSim*F 
IF(I~IA) 330, 330, 340 
330 A(I+2,J)=A (r+2,J)-PSII2|9E 
340 CONTINUE 

IFCI-IAI 350, 350, 360 
350 L=I+2 

GO TO 370 
360 L=N 

370 00 420 J=IO,L 

IFfl-lA) 380, 380, 390 
380 C=PSI(2)*A(J,I+2) 

60 TO 400 
390 C=O-D0 

400 E=AL=«'CA(J,I»+PSin )*AIJ,I+11+C) 
A( J,I)=A(J,1 )-E 
AIJ,I+1)=AIJ,I+1 I-PSII1I*E 
IFfl-IA) 410, 410, 420 
410 AIJ,I+2)=A (J,I+2)-PSI(2)*E 
420 CONTINUE 

IF(I-N+3) 430, 430, 440 

430 E=AL*PSI(2 )*All+3,I+2) 
AI1+3,I)=-E 
AC 1+3,1+1)=-PSI(1)*E 
A( I+3,l+2)=A(I-^3,I+2)-PSI(2l*E 
440 CONTINUE 
450 RETURN 
END 
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tHDGfP ORCON 
[FOR, IS ORCON 

COMPILFR ( XM=I), (FQUIV=CMN) 

SUBROUTINE ORCON ( A,M ,ROOTR ,ROOTI ,KR ,IPRNT, ITIMES ) 
IMPLICIT DOUBLE PREC ISION ! A-H ,0-2 > 

C PROGRAM TO CALL OR TRANSFORMATION, MAXIMUM ITER IS 50. 

DIMENS ION A ( KR ,1 ) , ROOTR U ) , ROOTI f 1 1 
TEST=l0.DO**(-2OJ*lO .D0*»(1*ITIMES) 

IF flTIMES .EO. 0) TEST=10.DO**l-20l 
N = M 

IF(IPRNT) 100, 110, 100 
100 WRITE (6,104) 

110 ZERO = 0.00 
JJ = 1 

120 XNN=O.DO 
XN2=0.D0 
AA = O.DO 
B = O.DO 
C = O.DO 
DO = O.DO 
R=0-D0 
SIG=O.DO 
ITER = 0 

130 IF(N-2) 140, 180, 190 

140 IF(IPRNT) 150, 160, 150 
150 WRITE (6,105)A(1,1) 

160 ROOTR(l) = A (1,1) 

ROOTKl) = O.DO 
170 RETURN 
180 JJ=-1 

190 X = (A(N-1,N-1) - A(N,N))»*2 
S = 4.D0*A (N,N-1)*A(N-1,M) 

ITER = ITEP + 1 
IF (X .EQ. O.DO) GO TO 240 
IF (DABS(S/X) .GT. l.OD-8) GO TO 240 
200 IF(DABS(A(N-1 ,N-1) )-DABS(A(N,N) )) 220, 220, 210 • 

210 E = A(N-1,N-1) 

G = A(N,N) 

GO TO 230 
220 G ~ A(N-1,N-1) 

E = A(N,V) 

230 F = O.DO 
H = O.DO 
GO TO 290 
240 S = X + S 

X = A(N-1,N-1) + A(N,N) 

1F(S) 280, 250, 250 

250 SO=DSORT(S) 

F=O.DO 

H=O..DO 


-005878 

-005879 
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-005882 

005883 
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005909 

005910 

005911 

005912 
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IF IX) 260, 260, 270 
260 F=IX-SQ)/2.D0 
G*(X+S0)/2.D0 
GO TO 290 
270 G=IX-S0)/2.D0 
E=(X+S0)/2.00 
GO TO 290 

260 F =DS0RTI-S)/2,D0 
E=X/2.00 
G=E 
H=-F 

290 IFIJJI 310, 300, 300 
300 D = TEST «(DABS(G) ♦ F) 

IF IDABSI AIN-1, N>2)) .GT. D) GO TO 340 
310 IFIIPRNT) 320, 330, 320 
320 WRITE 16,105 )E,F, ITER 
WRITE I6,105)G,H 
330 ROOTRIN) = E 
ROOTIIN) = F 
ROOTRIN-1) = G 
ROOTKN-l) = H 
N=N-2 

IFIJJ) 170, 120, 120 

340 1FIDABS|AIN,N-1>) .GT. TEST ♦DABS! A(N,N)y ) GO TO 380 

350 IFIIPRNT) 360, 370, 360 

360 WRITE I6,105)A(N,N), ZERO, ITER 

370 ROOTRIN) = AIN,N) 

ROOTIIN) = O.DO 

N=N-1 

GO TO 120 

380 IFIOABSIOABSIXNN/AIN,N-l))-l.D0)-1.00-8) 400, 400, 390 
390 IFIDABS(DABSIXN2/AIN-l,N-2))-l.D0)-1.0D-8) 400, 400, 490 
400 VQ=0ABSIACN,N-1) )-0ABS(AIN-l,N-2) ) 

IF IITER-15) 520, 410, 440 
410 IF I VO) 420, 420, 430 
420 R = ACN-l,N-2)**2 

SIG = 2.00*AIN-l,N-2) 

GO TO 570 

430 R = ACN,N-1)**2 

SIG = 2.D0*AIN,N-1) 

GO TO 570 

440 IFIVQ) 470, 470, 450 
450 IFIIPRNT) 460, 330, 460 
460 WRITE l6,107)A(N-l,N-2) 

GO TO 320 

470 IFIIPRNT) 480, 370, 480 
480 WRITE <6,107)A(N,N-1) 

GO TO 360 

490 IF I ITER .GT. 50) 60 TO 400 
IF I ITER .GT. 5 ) GO TO 520 
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500 RsE*E+F*F 

21= lE-AAl *(F-AA)+(F~BI*(F-e» 

IF (R ,NE. 0.00) 61) TO 501 

21 = O.DO 
GO TO 50? 

501 21 = 21/R 

502 R=G*G+H*H 

22= (G-C)*(G-C)+(H-DD»*(H“OD) 

IF CR .NE. 0.00) GO TC 503 

22 = 0.00 

GO TO 504 

503 22=22/R 

504 continue 

IF«21-0.25D0) 510, 510, 540 

510 IF 122-0. 2500) 520, 520, . 530 

520 R=F*G-F*H 
SIG=E+G 
GO TO 570 
530 K=E*E 
S1G=E+E 
GO TO 570 

540 IF 122-0.2500) 550, 550, 560 
550 R=G*G 
£IG=G*G 
GO TO 570 
560 R - 0.00 
SIG = 0.00 
570 XNN=A(N,N-1) 

XN2=A(N-l,N-2) 

CALL 0R2 { A,N,R,£IG,0,KR) 

AA=E 

B=F 

C=G 

DD=H 

GO TO 190 

I 104 FORMAT! ////IX, 9HREAL PART 6X 14HIMAG1NARY PART, 26X 

il 1 13HTAKEN AS ZERO 6X 4H1TER //) 

105 FORMAT(lX,D15.8,3X,D15.8, 42X 13) 

107 FORMAT(56X 013.8) 

END 
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[HDGfP ORDRVR 
I FOR, IS ORDRVR 

COMPILER (XM=1), (EOUIVsCMN) 

SUBROUTINE ORDPVR ( A ,N ,RR ,R I ,KR ) 
IMPLICIT DOUBLE PREC ISION ( A-H ,0-Z » 
DIMENSION A(KR,I),RR(I),Rni) 

PUT MATRIX INTO UPPER HESENBERG FORM 
CALL SUBDIA (A,N,KR,RJ) 

C CALCULATE EIGENVALUES USING OR METHOD 
CALL QRCON I A,N,RR,RI ,KR ,0,0) 

C ALIGN EIGENVALUES INTO INCREASING ORDER 

C 

NMl = N-1 
DO 35 J=1,NMI 
W2MIN - RR(J) 

WMIN = RKJ) 

IMIN = J 
JPl = J+1 
DO 30 I=JP1,N 

IF fW2MIN .LE. RR(in GO TO 30 
W2MIN = RR(I) 

WMIN = RI( II 
IMIN - 1 

30 CONTINUE 

RR(IMIN) = RRCJ) 

RKIMIN) = RKJ) 

RKJ) = WMIN 
35 RR(J) = W2MIN 
RETURN 
END 
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rHDGfP PFAD 

[FOR, IS READ 

COMPILER ( XM=1) , (EOUIV=CMNI 
SUBROUTINE READ <A tNR.NCtKRtKC) 

DOUBLE PRECISION A,X 

DIMENSION AIKR,1),X{4),IREMRK«9» 

DATA Wn ,NTT/5,6/ 

DATA lASTRS /IH*/ 

C 

C READ MATRIX OF REAL NUMBERS FROM CARDS AND PRINT IT. 

C THE EXPLANATION OF FORMATS USED BELOW IS ... 

C A - DENOTES ANY KEY PUNCH SYMBOL. CEGt A1/*CI. 

C 1 - DENOTES. AN INTEGER NUMBER. lEGt 436 1. 

C E - DENOTES A REAL NUMBER. (EGf 24.963). 

C FIRST CARD - MATRIX NAME, NUMBER OF ROWS , NUMBER OF COLUMNS 

C WITH A6, 14,15 FORMAT. 

C - REMARKS IN COLUMNS 16-69. A-TYPE FORMAT. 

C - ♦ IN COLUMN 72 TO PRINT MATRIX 

C MIDDLE CARDS - DATA WITH FORMAT (215, 4017). 

C - 1-ST 15 IS THE ROW NUMBER. 

C - 2-ND 15 IS THE COL NUMBER OF THE NEXT D17 FIELD. 

C - NEXT 4D17 ARE ELEMENTS OF THE MATRIX. 

C LAST CARD - TEN ZEROS IN COLUMNS 1-10. 

C 

C SUBROUTINE ARGUMENTS 


c 

A 

= OUTPUT 

MATRIX READ FROM 

CARDS . 


c 

NR 

= OUTPUT 

NUMBER OF ROWS IN 

MATRIX A. 


c 

NC 

= OUTPUT 

NUMBER OF COLS IN 

MATRIX A. 


c 

KR 

= INPUT 

ROW DIMENSION OF 

A IN CALLING 

PROGRAM 

c 

KC 

INPUT 

COL DIMENSICN OF 

A IN CALLING 

PROGRAM 


C 

1001 F0RMAT(A6, 14,15, 9A6,2XA1) 

1002 FORMAT (2I5,4D17.0) 

2001 FORMAT (//19H CARD INPUT MATRIX A6, 2X 1H( 14, 2H X 14, 2H ) 

* 2X 9A6,2X Al,//) 

2002 FORMAT (//1.9H CARD INPUT MATRIX A6, 2X 1H( 14, 2H X 14, 2H ) 

♦ 3X 9HC0NTINUED //) 

2003 FORMAT (// 1XA6, 14, 15 ,5X 9A6,2X Al ) 

2004 FORMAT (IX ?I5,4D17.8) 

2005 FORMAT (13H0END OF HEAD.) 

2006 FORMAT (25H0S1ZE OF MATRIX READ IS (14, 2H X 14, 2H ) ) 

C 

C READ IN HEADER CARD. 

READ (NIT, 1001) ANAME,N1,N2,IREMRK,IZ1 
IPRIN = 0 

IFdZl .EO. lASTRS) IPRIN = 1 
IF (IPRIN -EQ. 1) CALL PAGEHD 
C 

NR = N1 
NC = N2 


I 
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006060 
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006075 
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-006080 

006081 

006082 

-006083 

006084 

006085 

006086 

006087 

006068 

006089 

006090 

006091 

-006092 

006093 

-006094 

006095 

006096 

006097 

006098 




IFCIPRIN.EO.l) WRITE <NQT, 20011 ANAME# NR,NC . IREMRKt IZ 1 

-006099 


NERROR = 1 

006100 


IF (NR.GT.KR .OR. NC.GT.KC) GO TO 999 

006101 


NLINE = 0 

006102 


DO 105 1=1 , NR 

006103 


DO 105 J=1,NC 

006104 

105 

A( It J> = O.D 0 

006105 

110 

READ INIT, 10021 ItJS,X 

006106 


IF fI.EO.O .AND. JS.EQ.O) GO TO 400 

006107 


NERROR = 2 

006108 


IF (I.LE.O .OR. I.GT.NR .OR. JS.LE.O .OR. JS.GT.NCI GO TO 998 

006109 


JE = JS+3 

006110 


IF CJE.LE.NC) GO TO 115 

006111 


JX = NG-JS+Z 

006112 


NERROR = 3 

006113 


DO 112 J=JXt4 

006114 

112 

IF CXIJ) .NE. 0.0 0) GO TO 998 

006115 


JE = NC 

006116 

115 

N = 0 

006117 


DO 120 J=JS,JE 

006118 


N = N+1 

006119 

120 

A(ItJ) - X(N1 

006120 


NLINE = NLINE+1 

006121 


IF (NLINE. LE. 471 GO TO 125 

006122 


IF (IPRIN .EQ. 11 CALL PAGEHO 

006123 


IF (IPRIN .FQ. 1) WRITE (NOT, 20021 ANAME,NR,NC 

006124 


NLINE = 1 

006125 

125 

IF (IPRIN .EQ. 11 WRITE (NOT, 20041 I , JS , ( A( I , J 1 , J= JS, JEl 

006 1 26 


GO TO 110 

006127 

006128 

400 

IF (IPRIN .EQ. 11 WRITE (N0T,20051 

006129 


RETURN 

006130 


■ 

006131 

998 

WRITE (NOT ,20041 I,JS,X 

006132 

999 

WRITE (NOT, 20101 NERROR 

006133 

2010 

FORMAT (1H1,42HPR0GRAM STOPPED, ERROR IN SUBROUTINE READ, 

006134 


* lOH NERROR = ,131 

006135 


STOP 

006136 


END 

006137 


159 


IHDG»P RFADIM 
tFORtlS READIM 

COMPILER t IE0UIV=CMN» 

SUBROUTIW RFADIM ( 1 A,NR ,NC *KR tKC ) 
DIMENSION IA«KRfl)ilX( 14) ,REMRKI9) 
DATA NIT,NDTfIASTRS/ 5, 6» 1H» / 

C 

CC — TAKEN FROM FORMA. 

CC — ACKNOWLEDGEMENT GIVEN TO RF HRUOA. 

C 


1001 FORMAT (A6 ,14,15, 9A6, 2XA1) 

1002 FORMAT (1615) 

2001 FORMAT (//?7H CARD INPUT INTEGER MATRIX A6, 2X IH( 14, 2H X 14, 2H ) 

* ?X VA6,//) 

2002 FORMAT (//27H CARD INPUT INTEGER MATRIX A6, 2X IH ( 14, 2H X 14, 2H ) 

♦ 3X 9HC0NTINUED //) 

2004 FORMAT (IX 1615) 

2005 FORMAT (15H0END CF READIM.) 

2006 FORMAT ( IH 1 , 37HE RR OR IN SUBROUTINE READIM, NERROR = ,131 
C 

C READ IN HEADER CARD. 

READ (MIT, 1001) ANAME,N1 ,N2,REMRK, IZl 
IPPIN = 0 

IF CIZl .EO. lASTRS) IPRIN = 1 
IF I IPRIN .EO. 1) CALL PAGEHD 
C 

NR = N1 
NC = N2 

IF (IPRIN .EC. 1) WRITE (N0T,2001) ANAME ,NR ,NC ,REMRK 
NERROR = 1 

IF (NR.GT.KR .C>P. NC.GT.KC) GO TO 999 


NLINE = 0 
DO 105 1=1 ,NR 
DO 105 J=1 ,NC 
105 1ACI,J) = 0 
110 READ (NIT,1002) I,JS,IX 

IF (I.EO.O .AND. JS.EO.O) GO TO 400 
NERROR = 2 

IF Cl.LE.O .OR. I.GT.NR .OR. JS.LE.O 
JE = JS 13 

IF IJE .LE. NC) GO TO 115 
JX = NC - JS + 2 
NERROR = 3 
DO 112 J=JX,14 
IF (IXCJ) .NE. O) GO TO 998 
112 CONTINUE 
JE = NC 
115 N = 0 

DO 120 J=JS,JE 
N = N + 1 


-006 1 38 
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.OR. JS.GT.NC) GO TO 998 006176 
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120 s IX(N) 006188 

NLINE - NLINE + 1 006189 

IF INLINE .LE. 47) GO TO 125 006190 

IF flPRIN .EO. 1) CALL PAGEHD 006191 

IF (IPRIN .EO. 1) WRITE I NOT* 2002) ANAMF,NR*NC 006192 

NLINE = 1 006193 

125 IF f IPRIN .EO. 1) WRITE (NOT,2004) I *JS *1 lAI I »J) « J=:JS* JE ) 006194 

GO TO 110 006195 

C 006196 

400 IF I IPRIN .EQ. 1) WRITE (N0T»2005) 006197 

RETURN 006198 

C 006199 

998 WRITE (NOT *2004) I»JS»IX 006200 

999 WRITE (NOT *2006) NERROR 006201 

STOP 006202 

END 006203 



or>ooor>or>oooonr»oor>nooooonoor» 


161 


[HDG,P PEVADO 
IFOR, IS RFVADD 

COMPILER ( XM = 1), <FQUIV=CMNI» 

SUBROUTINE REVADD ( ALPHAt A , I VEC , JVEC ,2 ,NR A.NCA.MRZ ^NCZ ,KR A wKRZ ) 
IMPLICIT DOUBLE PREC IS ION ( AH4 »0-Z ) 

DIMENSION A(KRA,1), IVEC(1», JVEC(1)» Z(KRZtl) 


REARRANGE AND ADD ROWS AND COLUMNS OF ALPHA ♦ MATRIX A INTO 
MATRIX Z. 

BE SURE MATRIX Z IS DEFINED BEFORE CALLING THIS SUBROUTINE. FOR 
EXAMPLE, CALL ZERO TC CLEAR MATRIX Z. 


SUBROUTINE 
ALPHA = INPUT 


A 

IVEC 


Z 

NRA 

NCA 

NR2 

NC2 

KRA 

KR2 


INPUT 

INPUT 


II. 

II. 


JVEC = INPUT 


ARGUMENTS 

SCALAR THAT MULTIPLIES MATRIX A. 

MATRIX TO BE ARRANGED AND ADDED. SIZE (NRA ,NCA I . 

VECTOR. SIZE(NRAI. 

IVECMI=ROW POSITION OF AlROV# II IN Z. 

IF IVECdl IS PLUS ,Z=Z(KOW IVECd I l+ALPHA*A(ROW 
IF IVEC! 1 1 IS MINUS ,Z = ZIROW IVEC ( 1 1 l-ALPHA*A (ROW 
IF IVECdl IS ZERO , A(ROW II IS OMITTED IN Z. 

VECTOR. SIZE(NCA). 

JVEC(JI=COL POSITION OF A(COL Jl IN Z- 

IF JVEC(JI IS PLUS ,2=Z(COL JVEC! Jl l♦ALPHA♦A(COL Jl. 

IF JVEC(JI IS MINUS, Z=2(COL JVEC( Jl |-ALPHA*A(COL Jl. 

IF JVEC(JI IS ZERO , A(COL Jl IS (?MITTEO IN Z. 

INPUT /OUTPUT MATRIX TO WHICH ALPHA^A IS ADDED. SIZE (NRZ,NCZ I . 
INPUT NUMBER OF ROWS IN MATRIX A. 

NUMBER OF COLS IN MATRIX A. 

NUMBER OF ROWS IN MATRIX Z. 

NUMBER OF COLS IN MATRIX 2. 

ROW DIMENSION OF A IN CALLING PROGRAM. 

ROW DIMENSION OF Z IN CALLING PROGRAM. 


INPUT 

INPUT 

INPUT 

INPUT 

INPUT 


DO 30 IA=1 ,NRA 

IZ = IABS( IVECdAI I 

IF (IZ .EQ. 01 GO TO 30 

DO 25 JA=1 ,NCA 

JZ = IABS( JVEC(JA1 I 

IF (JZ .EQ. 01 GO TO 25 

SIGN = +1.D0 

IF (IVECdAI .LT.O .AND. J VEC ( JAI .GT.O .OR. 

♦ IVECdAI. GT.O .AND. JVEC! JAI. LT. 01 SIGN=-1.00 
Z(IZ,JZI = Z(IZ,JZI + SIGN*ALPHA*A(IA,JAI 
25 CONTINUE 
30 CONTINUE 
RETURN 

END 


-006204 
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tHDGfP REVISE 
C FOR, IS REVISE 

COMPILER I XM=1), fEOUIV=CMNI 

SUBROUTINE REVISE ( A , IVEC , JVEC,Z,NRA,NCA,NRZ,NCZ,KRA,KRZ ) 
IMPLICIT DOUBLE PR EC IS ION ( A-H,0-Z ) 

DIMENSION A(KRA,n, IVECIl), JVECCll, Z(KRZ,1} 

DATA NOT / 6/ 

REARRANGE ROWS AND COLUMNS OF MATRIX A TO FORM MATRIX Z. 

CALLS FORMA SUBROUTINE ZZBOMB. 

COOED BY RF HRUDA. FEBRUARY 1965. 

LAST REVISION BY RL WOHLEN. OCTOBER 1972. 

SUBROUTINE ARGUMENTS 

A = INPUT MATRIX TO BE REARRANGED. SIZE(NRA,NCA ) . 

IVEC = INPUT VECTOR. SIZEfNRA). 

IVEC(II=RDW POSITION OF A(ROW II IN Z. 

IF IVECCI) IS PLUS , ZCROW IVECd)) = +A(ROW I). 

IF IVECd) IS MINUS, ZCROW IVECCI)) = -ACROW I). 

IF IVECCI) IS ZERO , ACROW I) IS OMITTED IN Z. 
JVEC = INPUT VECTOR. SIZECNCA). 

JVECCJ)=CCL POSITION OF ACCOL J) IN Z. 

IF JVECCJ) IS PLUS , ZCCCL JVECCJ)) = +ACCOL J). 

IF JVECCJ) IS MINUS, ZCCOL JVECCJ)) = -ACCOL J). 

IF JVECCJ) IS ZERO , ACCOL J) IS OMITTED IN Z. 

Z = OUTPUT RESULT MATRIX. SIZE CNRZ,NCZ ) . 

NRA = INPUT NUMBER OF ROWS IN MATRIX A. 

NCA = INPUT NUMBER OF COLS IN MATRIX A. 

NRZ = INPUT NUMBER OF ROWS IN MATRIX Z. 

NCZ = INPUT NUMBER OF COLS IN MATRIX Z. 

KRA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM. 

KRZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM. 

DO 10 1=1, NRZ 
DO 10 J=I,NCZ 
10 ZCI,J) = O.D 0 

DO 30 1A=1,NRA 
IZ = lABSC IVECCIA) ) 

IF CIZ .EO. 0) GO TO 30 
C 

IF CIZ .GT. NRZ) GO TO 999 
DO 25 JA=1 ,NCA 
JZ = lABSC JVECCJA) ) 

IF CJZ .EO. 0) GO TO 25 
C 

IF CJZ .GT. NCZ) GO TO 999 
SIGN = +1.D 0 

IF C IVECCIA) .LT.O .AND. JVECC JA ) .GT.O .OR. 

♦ IVECCIA) .GT.O .AND. JVECC JA) .LT.O) SIGN=-1 .D 0 




i 
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Z(IZtJZ) 
25 CONTINUE 
30 CONTINUE 
RETURN 


SIGN«A(IA»JAI 


999 WRITE INOT.lOOl) 

1001 FORMAT flHl,32HERRCR 
STOP 
END 


IN REVISE* PROGRAM STOPPED) 


o o 
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CHDGtP RKADAM 
t FOR, IS RKADAM 

COMPILER (XMsl), (EOUIV-CMNI 

SUBROUTINE RKADAM fNEQ I 

IMPLICIT DOUBLE PRECISION! A-HyO-Z) 

C 

COMMON /J ILF LG/ 

♦ JIL 

COMMON /PRWORK/ 

♦ PR(250,5) 

COMMON /QPRKTA/ 

♦ QRK(250),PRKI4| , NT 

COMMON /TIMESS/ 

♦ STARTT,DELTAT,T,ENDT,TMST 

COMMON /VECTOR/ 

♦ Y1250),YDTC250) 

COMMON /VINOEP/ 

♦ INDEPC250I 
C 

DATA EPSl, EPS2 / 1 .D-8 , l.D-2 / 

DATA NOT, MAX IT / 6, 10/ 

C 

C ***** ITYPE ,EQ. 1 RUNGE-KUTTA INTEGRATION 

C ***** ITYPE .EQ. 2 ADAMS PREDICTOR/CORRECTOR INTEGRATION 

C 

C SUBROUTINE TO INTEGRATE DIFFERENTIAL EQUATIONS (FIRST ORDER) 

C IN THE TIME DOMAIN. USES RUNGE-KUTTA-GILL TO START THE ADAMS PREDICT 
C CORRECTOR. MAY USE RUNGE-KUTTA ONLY, ON OPTION. 

C CODED BY CARL BOOLEY 1971 

C MODIFICATION TO CORRECTOR LOOP TO ACCOUNT FOR IMPULSIVE CHANGE TO 
C STATE VECTOR (O)TWHICH OCCURS IN SUB. YDOT. MADE BY CARL BGDLEV 

APR, 1974 

DATA ITYPE / 1 / 

C 

GO TO (10,20) , ITYPE 
C 

20 IF (NT .GT. 0) GO TO 201 
ONM = DELTAT/24.D 0 
TRl = 0NM+55.D 0 

TR2 = -DNM*59.D 0 
TR3 = DNM+37.0 0 

TR4 = -DNM* 9.D 0 

TR5 = ONM* 9.D 0 

TR6 = DNM*19.D 0 
TR7 = -DNM* 5.D 0 

TR8 = ONM* 1.0 O 

C 

201 IF (NT .GT. 3) GO TO 200 
NL = NT + 1 


-006311 

-006312 

-006313 

006314 

-006315 

006316 

-006317 
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205 


10 


DO 205 1=1 »NEQ 
l>R{I,NLI = YDTCI) 

PR (If 5) = V (I) 

IF (NT .FQ. 3) GO TO 


lf4 


200 


101 

103 

105 

10 ? 

110 

120 


200 

204 


207 


203 


DO 120 J = 

JIL = J 

DO 110 1=1 ^NEO 

IF (INOEPdl •EQ. 0) GO TO 110 
Z = YOTdl^OELTAT 
GO TO (103f]01fl01«105) f JIL 
R = PRKtJIU^fZ QRKCD) 

GO TO 107 

R = PRK(JIL)*Z - ORK(I) 

GO TO 107 

R = (Z - 2.D 0^0RKCI))/6.b 0 
V(I) = Y(I> ♦ R 

QRK(I) = ORK(I) ♦ 3.D O^R PRKCJID^Z 
CONTINUE 

IF (JIL .EO. 1 .OR. JIL .EO. 3) T = T + DELTAT/2.D O 
CALL YOOT 
GO TO 300 

DO 204 1=1, NEC 

Y( II = PRC If 5)+TRl*PRIIf4l+TR2*PRII,3) + TR3*PRn,2l+TR4^PR(I,l ) 
T = T ♦ OELTAT 
ITER = 0 
CALL YDCT 

G = O.D 0 
DO 203 I=lfNEQ 

IF (TNDEPd) .EO. 0) GO TO 203 

YC = PR(I,5)+TR5^YOTf n +TR6*PR 1 1,4 >+TR7*PR 1 1 » 3 l+TR8*PR C I * 2 1 
DN = OABSfYdll 
DNl = DABS(YC) 

IF (DNl .GT. ON) DN = DNl 
IF (ON .LT. EPSl) GO TO 203 
G1 = DABS(YC - YCDI/ON 
IF (G1 .GT. G) G = G1 
Yd) = YC 
CONTINUE 
ITER = ITER + 1 
IF (G .LE. EPS2I GO TO 
IF (ITER .EO. MAXIT) GO iO 
GO TO 207 


999 


30 DO 210 1=1, NEQ 
PR (1,1 1 = PR(T,2) 
PR(I,2) = PR(I,3) 
PR(I,3) = PP(I,4) 
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PRCI»4| = YDTU) 006411 

210 PR(I»6) = VIII 006412 

C 006413 

300 NT = NT + 1 006414 

ANT = NT 006415 

TMST = ANT^OELTAT 006416 

T = STARTT ♦ TMST 006417 

C 006418 

RETURN 006419 

999 WRITE CNOTtlOOl) MAX IT 006420 

1001 FORMAT (lHlt3lHC0RPECT0R FAILS TO CONVERGE IN I3t 006421 

♦ 28HITE RATIONS t PROGRAM STOPPED.) 006422 

STOP 006423 

END 006424 
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tHDG.P RLCCUS 
[FOR, IS RLOCUS 

COMPILER C XM=1), CEOUIV=CMN) 

SUPROUTINE RLOCUS (PPR ,QQR , SCL,SR ,SI ,NP ,NQ,THETAO, 
1 XMIN,XMAX»VMAXfALOC) 

IMPLICIT DOUBLE PR EC ISICN (A-H f 0-Z » 

DOUBLE PRECISION K 

REAL XSAVE, YSAVE, SAVED, SAVEP, SAVED, SAVEA 


COMPLEX 

INTEGER 


S,P,Q,Sn,SOR,ERR,DCHPLX 


SUBROUTINE DETERMINES ROOT LOCI FOR A SINGLE ROOT. 

SUBROUTINE ARGUMENT DESCRIPTIONS 


SCL 

SR 

SI 

NP 

NO 

XMIN 

XMAX 

YMAX 

ALOC 


INPUT NUMERATOR POLYNOMINAL COEFFICIENTS. 

INPUT DENOMINATOR POLYNOMINAL COEFFICIENTS. 

NOTE.... ALL POLY COEFFICIENTS ARE IN ASCENDING ORDER. 
INPUT SCALE FACTOR. NORMALLY =1. 

INPUT REAL PART OF STARTING ROOT. 

INPUT IMAG PART OF STARTING ROOT. 

INPUT SIZE OF PPR. 

INPUT SIZE OF OOR. 

INPUT MINIMUM ADMISSIBLE REAL ROOT VALUE. 

INPUT MAXIMUM ADMISSIBLE REAL ROOT VALUE. 

INPUT MAXIMUM ADMISSIBLE IMAG ROOT VALUE. 

INPUT PHASE CONTROL PARAMETER 

ALOC = +1 +180 DEGREES PHASE, 

ALOC = -1 0 DEGREES PHASE. 


DIMENSION PPRCl) ,00R(1) 
DIMENSION PARC 50» , OAR ( 50) 
DIMENSION XSAVE«500),YSAVEI500) 


COMMON /PS TUFF/ 

♦ SAVEO(500), SAVEP(500), SAVEDC500), SAVEAfSOO), KSAVE 

COMMON /LVl / 

C VI ( 50), V2 C 50), V3 C 50) 

EQUIVALENCE (Vl( I ) ,PAR(I) ) , fV2(l) ,OAR < 1 )) 

EQUIVALENCE (SAVED C 1 ) ,XSAVE ( 1 )) , (SAVEP (1 ) ,YSAVEf 1) ) 


DATA OUT, 
1 6 , 


KOSAVE 

500 


KSAVE = 


PI=3.1415P 2653589793D0 


r>or> oooonoo or>r> 


ATR = 180.00/PI 
WRITE HEADINGS 


NP1=NP-^1 ^ 

NQ 1=NQ-1 
CALL PAGEHD 
WRITE (OUT, 38) 

38 FORMAT C "OP CS) =" ) 

WR ITE I OUT, 40 ) PPR ( 1 ) , C PPR 1 1 ♦! ) , 1 , 1=^1 ,NP 1 ) 

WRITE (OUT, 39) 

39 FORMAT ("OQ(S) =^« ) 

WRITE(0UT,4O) Q0R(1),(00R(I4^1),I,I==],NQ1) 

40 FORMATI" ♦ (" ,022 .15 ,6X,3 (" + ( ",D 22.15 ,")♦$=►♦", 12 ) / 

^ H C«, 022.15, 12)) 

WRTTECOUT, 10)SR,SI 

10 FORMAT ("OS TARTING POINT = I", F18.il,") If", F 18.11 ,")") 

WRITE! OUT, 15) XMIN ,XMAX,YMAX, YMAX 
15 F0RNAT(«0SCAN LIMITS ",D13.6," LT X LT ",D13.6/" ",12X,"--", 

♦ D12.6," LT Y LT ",013.6) 

NLINE = 0 
CALL PAGEHD 
WRITE I OUT, 20) 

20 F0RMATI//1 3X, "GAIN", 33X, "ROOTS" ,43X, "ERROR"//) 

FIND SCALE FACTOR (SCL) IF NOT SPECIFIED. 

IF THE INPUTTED SCL IS POSITIVE, THAT VALUE WILL BE USED TO 
SCALE THE TWO POLYNOMIALS. IF THE SCL IS NEGATIVE, A SCALE 
FACTOR WILL BE ESTIMATED FROM THE SIZE OF THE COEFFICIENTS OF 
THE POLYNOMIALS. 

TF(SCL.GT.O.DO)GO TO 100 
CALL FIT(NP,PPR,SLOPEP) 

CALL FTT(NO,OOR,SLOPEO) 

SCL=1.D1*^(-(NP^SL0P EP+NQ*SLOPEQ)/(NP-fNQ)) 

100 WRITE! OUT, 101) SCL 

101 FORMAT("OSCALE FACTOR =",013. 6) 

SCALE EQUATIONS BY LETTING S (NEW ) =SCL^S f OLD ) 

ABP=DABS(PPR(NP)) 

ABO=DAB$(QOR(NC)) 

DO 120 I=1,NP1 
ABPP=PPR(I )/ABP 
NPT=NP-I 
DO 110 J=1,NPI 
110 ABPP=ABPP/SCL 
120 PAR(I)=ABPP 

DO 140 1=1 ,N01 
ABQQ=QQR(I)/AeQ 
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NOI=NO-I 
DO 130 J=1 ,NOI 
130 AeQO=ABQQ/SCL 
lAO CARm=ABOO 

PAR(NP )=DSIGN( l.OO.PPR (NP) ) 

OAR ( NO ) =DS IGN ( 1 . DO ,QOR (NO > ) 

VK=ABO/ABP 

C VK=RATIO OP THF MAGNITUDE OF THE LEADING COEFFICIENTS 

NONP=NQ-NP 
DO 150 I=1,NCNP 
150 VK=VK*SCL 

INITIALIZE VALUES 

NROOTS=0 
TR=SR/SCL 
TI=S1/SCL 
S0=DCMPLXITR,TI) 

X=SR 
Y=SI 
IJP=0 
IVS=0 

RMlNN=I,D-4 
RMIN=RMINN/SCL 
RMAX=1.01/SCL 
BD^RMIN 
THETA1=THE TAO 
THMAX=370.D0+THETA1 
THETA2=0.00 
DTM=1.D-B 
DTHETA=10.D0 

START SEARCH 

190 THETA=THETAl/ATR 

SOP=SNGL(RD)*DCMPLX(DCOS(THETA),OSIN(THETA) ) 

S=SO-*-SOR 

C S IS THE POINT TO BE EXAMINED 

C NOW EVALUATE P(S) AND 0(SI 
P=PAR(NP ) 

0=OAR(NO) 

DO 200 1=1, NPl 
200 P=P*S + SNGLCPARfNP-in 
DO 210 I = 1,NQ1 
210 0=0*S+SNGL(OAR(NQ-I) ) 

C FIND PHASE ANGLE OF P(S)/OfS) 

AP=DREAL(P> 

BP=DIMAG(P) 

CO=DREAL(Q) 

DQ=DIMAG(Q) 
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C 


THN=:BP*CQ--AP>^DQ 
THD=AP^CQ4.BP*DQ 
AN GL=0 AT AN 2 ( THN , THD ) 

ANGL=PHASF ANGLE IN RADIANS OF PCS)/Q(S) 

TH1=ATR*AMGL 

TH1=PHASE ANGLE IN DEGREES 

NEXT CHECK TO SEE IF THIS NEW PHASE ANGLF HAS CROSSED THE 180 DEG 
IFdJP.EC. DGO TO 220 
IF (THD.GE.O.DO) GO TO 219 
IVS=-~DS IGN Cl . 1 DO , THN ) 

IJP=1 

219 IFdVS.EQ.OGO TO 280 

220 IFCTHD.LE.O.DOGO TO 225 
TVS=0 

IJP=0 
GO TO 260 

NEXT THREE CARDS**IF THE 180 OEG LINE HAS BEEN CROSSED, TURN 
AROUND AND REDUCE THE SEARCH INCREMENT 
225 I1THN=:DS1GN( 1.100, THN) 

IF(TVS-I1THN.NE.0.D0)G0 TO 260 
DTHETA=-0THETA/1 .D1 

THIS METHOD OF ADJUSTING DTHETA IS VERY INEFFICIENT. 

IVS=-DSIGNfl .100,THN) 

IVS REMEMBERS ON WHICH SIDE OF THF 180 DEG LINE THE LAST PHASE 
ANGLE LAY 

260 IF C DABS (DTHETA I.LT.DTM) GO TO 290 
280 IF (THETAl.GT.THMAX)GO TO 300 
TH ETA 1 “THETA 1 +OTHETA 
GO TO 190 

END SEARCH 

NEXT WRITE RESULTS OF SEARCH 

290 IFC0ABSC180.D0-DABS(THI)).LE.5.D0)G0 TO 310 

300 RD=RD/1.5D0 
ANGINC-109 .4700 
THETA1=THETA3 
S=SO 

IF(RD.GT.PMIN)GO TO 350 
IFCNROOTr.FG.O)GO TO 304 
WRITE (CUT, 301) RMINN 

301 F0RMATI”0THE LAST POINT PRINTED IS WITHIN •»,F7.5," OF A ROOT.") 
RETURN 

304 WRITE! OUT, 305 1 RHINN 

305 FORMAT(«OTHE INITIAL POINT IS NOT WITHIN ",F7.5t" OF THE LOCUS.") 
RETURN 

310 IFCDABSd8 0.DO-DABS(THl))*GE.1.0--3)WRITE(0UT,270)THI 
270 FORMAT!" MINIMUM VALUE OF DTHETA REACHED, PRESENT VALUE OF THETA I 
*S"»FI5.9) 

K=VK^CABS(Q)/CABSCP)<^ALOC 


006575 
006576 
006577 
006578 
006579 
006580 
0065B1 
006582 
006583 
006584 
006585 
006586 
006587 
006588 
006589 
006590 
006591 
006592 
006593 
0C6594 
006595 
006596 
006 5 P7 
006598 
006599 
006600 
006601 
006602 
006603 
006604 
00660!> 
006606 
006607 
006608 
006609 
006610 
006611 
006612 
006613 
006614 
006615 
006616 
006617 
006618 
006619 
006620 
006621 
006622 
006623 
-"006624 


no noon 


NROOTS=NROrTS+l 
X=DREAL<SI*SCL 
Y=DIMAG(S>*SCL 
YY-DABS(Y) 
tRR=0+P»SNGLCK/VK) 

THETA3=THETA1 
SC=S 

NLINE = NLINE 1 
IF (NLINE .LT, 50) GO Tn 31A 
NLINE = 1 
CALL PAGEHD 
WRITE (0UT,?0) 

314 WRITE(rUT,50)K,X,Y,ERR 
XSAVE(KSaVE) = X 
YSAVE(KSAVE) = Y 
50 FORMAT(5(6X,Gie,9) ) 

IF ((X .LT. XMIN .OR. X .GT. XMAX .OR. YY .GT. YMAX) 
♦ .OR. (KSAVE .GE. KDSAVE)) RETURN 

KSAVE = KSAVE + 1 

ADJUST SEARCH RADIUS 

FIND ACUTE ANGLE BETWEEN THETAl AND THETA2 (THOIF) 
THDI F 1 =DAB S ( THETA1-THETA2 ) 

TKDIF=DMIN1 (THDIFl ,360.D0-THDIF1 ) 

ADJUST SEARCH RADIUS IF THDIF IS LESS THAN 15 DEG OR 
GREATER THAN 30 DEG 
IANG=THDIF/15.D0 
IF(IANG-l) 320,340»330 
320 RD = 1.5DO*RO 

ANGINC-138 .59D0 
1F(RD.LB.RMAX)G0 TO 350 
RD=RD/1.5D0 
GO TO 340 
330 R0=RD/1.5D0 

ANGINC = 109 .A7D0 
IF(RD.GE.RM1N)G0 TO 350 
RD=1 .500»RD 
340 ANGINC = 120 .DO 
350 THETA2=THETA1 
C SET ANGLE SCANNING LIMITS 
THETA1=THETA2-ANGINC 
THMAX =THETA2+AMGINC 
DTHETA=1.D1 
IJP=0 
IVS=0 

so=s 

GO TO 190 
END 


006625 

006626 

006627 

006628 

-006629 

006630 

006631 

006652 

006633 

006634 

006635 

006636 

006637 

006638 

006639 

006640 

006641 

006642 

006643 

006644 

006645 

006646 

006647 

006648 

006649 

006650 

006651 

006652 

006653 

006654 

006655 

006656 

006657 

006658 

006659 

006660 

006661 

006662 

006663 

006664 

006665 

006666 

006667 

006668 

006669 

006670 

006671 

006672 

006673 


onnnnnooooonnooo 


f 

f 
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fHOG.P RLPLOT 
[FOR, IS RLPLOT 

COMPILER (XM=1I,(E0UIV=CMN» 

SUBROUTINE RLPLOT ITITLE, ISNIM,ICYC,IRLC) 

*** 

*♦» MSFC UNI VAC 1108 VERSION ♦♦♦ 

SUBROUTINE PLOTS ROOT LOCI FOR A SINGLE ROOT, 


C 

C 


-SUBROUTINE ARGUMENT DESCRIPTIONS 


TITLE 

ISNIM 


ICYC 

IRLC 


= INPUT ALPHA NUMERIC TITLE 
= INPUT ROOT IDENTIFICATION PARAMETER. 

=1 STARTING POINT IS OPEN LOOP ZERO, 

-2 STARTING POINT IS OPEN LOOP POLEt 

=3 STARTING POINT IS CLOSED LOOP POLE. 

= INPUT TRANSFER FUNCTION COUNT (PLACED ON PLOT), 
= INPUT ROOT LOCUS CYCLE NUMBER (PUT ON PLOT) 


COMMON /LSTART/ IRUNNOt IDATE, NPAGE 
COMMON /PS TUFF/ 

* SAVE0(500)t SAVEP(500)t SAVED(500), SAVEA(500)t KSAVE 

DIMENSION TITLE(1),TX(I2) ,TY(12) 

DIMENSION AGR (99) 

EQUIVALENCE ( IRUNNO,RUNNO ) 


TX( 1) = 6H 
DO 5 1=1,10 
5 TXII+1) = TITLE(I) 
TX(12) = 6H 


-006674 

-006675 

-006676 

-006677 

-006678 

-006679 

-006680 

-006681 

-006682 

-006683 

-006684 

-006685 

-006686 

-006687 

-006688 

-006689 

-006690 

-006691 

-006692 

-006693 

-006694 

-006695 

-006696 

-006697 

-006698 

-006699 

-006700 

-006701 

-006702 



DATA 

6H 

AGR 

1 

/ 

v6H 

2 

ir6H 

3 

t6H 

4 

f6H 

5 

y6H 

6 

t6H 

7 

->006703 
, -006704 


6H 

8 

d6H 

9 

t6H 

10 

t6H 

11 

«6H 

12 

,6H 

13 

«6H 

14 

9 -006705 


6H 

15 

♦ 6H 

16 

f6H 

17 

f6H 

18 

t6H 

19 

♦ 6H 

20 

t6H 

21 

9 -006706 

♦ 

6H 

22 

f6H 

23 

,6H 

24 

f6H 

25 

»6H 

26 

y6H 

27 

f 6H 

2 8 

9 -006707 

♦ 

6H 

29 

»6H 

30 

f6H 

31 

,6H 

32 

f6H 

33 

r6H 

34 

f 6H 

35 

9 -006708 


6H 

36 

v6H 

37 

v6H 

38 

y6H 

39 

f6H 

40 

f6H 

41 

f6H 

42 

9 -006709 


6H 

43 

v6H 

44 

v6H 

45 

,6H 

46 

f6H 

47 

f6H 

48 

»6H 

49 

9 -006710 

♦ 

6H 

50 

»6H 

51 

»6H 

52 

y6H 

53 

t6H 

54 

»6H 

55 

t6H 

56 

9 -006711 


6H 

57 

,6H 

58 

» 6h 

59 

f6H 

60 

f 6H 

61 

f6H 

62 

y6H 

63 

9 -006712 

♦ 

6H 

64 

t6H 

65 

,6H 

66 

,6H 

67 

f6H 

68 

,6H 

69 

y6H 

70 

9 -006713 


6H 

71 

y6H 

72 

,6H 

73 

t6H 

74 

»6H 

75 

»6H 

76 

»6H 

77 

9 -006714 


6H 

78 

,6H 

79 

v6H 

80 

,6W 

81 

f6H 

82 

y6H 

83 

»6H 

84 

9 -006715 

* 

6H 

85 

y6H 

86 

f6H 

87 

«6H 

88 

t6H 

89 

*6H 

90 

t6H 

91 

9 -006716 

* 

6H 

92 

f6H 

93 

t6H 

94 

y6H 

95 

»6h 

96 

»6H 

97 

t6M 

98 

9 -006717 


6H 

99 

/ 












-006718 


-006719 

-006720 

-006721 

-006722 

-006723 


1 


1 


c 

TY( 1) = 6HR00T L 
TY( 2) = 6H0CUS P 


TY{ 3) = 

6HL07 




IFdSNIM 

.FO. 

3) 

TY( 

4) = 6HCLSD 

IFdSNIM 


3) 

TY( 

4) = 6H0PEN 

TY( 5> = 

6HL00P 



IF CISNIM 

.EO. 

1) 

TY( 

6» = 6HZERC 

IF (ISNIM 

• NE. 

1) 

TY( 

6) = 6HP0LE 

TY( 7 ) = 

6H 




TY( 8) = 

6HCY 

EQ 




TY( 9) = AGR(ICYG) 

TY(IO) = 6HRL EO 
TYIIU = AGR(IRLC) 

TY(12) = RUNNO 
C 

XMIN = SAVEO(l» 

XMAX = XMI^ 

YMIN - SAVEPd) 

YMAX - YMIN 

DO 10 1=2,KSAVF 

XMIN = AMINl IXMINtSAVEOCIM 

XMAX = AMAX1(XMAX,SAVE0(I)> 

YMIN = AMINI (YHIN,SAVEP(n) 

10 YMAX = AMAXl (YMAXfSAVEPd)) 

C 

CALL PLOTSS(XMAX,XMIN,XRGT,XLFT) 
CALL PLOTS S( YMAX, YMIN, YTOP,YBOT) 

C 

IFdSNIM .EO. 1) ISY = AHZERO 
IFdSNIM .NE. 1) ISY = AHPOLE 
CALL QUIK3L(-1,XLFT,XRGT,YBCT,YT0P, 
♦ SAVEO,SAVEP) 

CALL XSCLVKSAVEOdI ,IXR,1XE) 

CALL YSCLVKSAVEPdl ,IYR,IYE» 

CALL PRINTV(4,ISY,IXR,IYR » 

C 

RETURN 

END 
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-006724 

-006725 

-006726 

-006727 

-006728 

-006729 

-006730 

-006731 

-006732 

-006733 

-006734 

-006735 

-006736 

-006737 

-006738 

-006739 

-006740 

-006741 

-006742 

-006743 

-006744 

-006745 

-006746 

-006747 

-006748 

-006749 

-006750 

-006751 

-006752 

-006753 

-006754 

35,TX,TY,-KSAVE, -006755 

-006756 

-006757 

-006758 

-006759 

-006760 

-006761 

-006762 


onnoonoo 
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tHDG,P RMVZRO -006763 

[FOR, IS RMVZRO -006764 

COMPILFR (XM=1), {EOUrV=CMNI -006765 

SUBROUTINE RMVZRO fRR,NR) 006766 

IMPLICIT DOUBLE PRECISION* A-H,C-ZI -006767 

006768 

SUBROUTINE REMOVES REAL ZEROS FROM REAL ROOT ARRAY, 006769 

006770 

SUBROUTINE ARGUMENT DESCRIPTIONS 006771 

006772 

RR = INPUT/OUTPUT ARRAY CONTAINING ALL REAL ROOTS. 006773 

NR = Is^PUT/OUTPUT NUMBER OF REAL ROOTS. 006774 

006775 

DIMENSION RRCl) 006776 

C 006777 

K=0 006778 

DO 10 1=1, NR 006779 

IF *RR(I) ,EQ. O.DOl GO TO 10 006780 

K=K+1 006781 

RR(K) = RRCII 006782 

10 CONTINUE 006783 

NR = K 006784 

RETURN 006785 

end 006786 
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tHOGfP ROTDH 
fFORL.lS ROTDH 

COMPILER (XM=l)t CFOUIV=CMN) 

SUBROUTINE ROTDH 

IMPLICIT DOUBLE PREC ISICN I A-H , 0-Z ) 

C 

COMKCfN /BHESRD/ 

♦ PH(6,12, 9) ,BS(6,12,10),R0L(3,3, 5».DOU3, 5) 

COMMON /HANDS / 

♦ HATHI3, 6, 8),S1GHI3, 6, 8),HATSI3, 6,10) .S1GSI3, 6,10) 

COMMON /PINRP / 

♦ PIN(3,3, 5), RP2(3,3, 5), RP?(3,3, 5) 

COMMON /SPECIE/ 

♦ BFTAH(6, 5),BETAHDJ6, 5),AM0)2, 5 ) ,RH C 3,3 ,24 ) ,RS C 3,3 ,20 ) , 

♦ DH(3,2E),DSC3,20),IM013, 5),NMUW(5, 5 ) , IFTSMW ( 10 ) , 

♦ NB,NH,NSP1 ,NOFMO,NDELTA,irOPOU2, 5),lPGFLXf 5),IHDATA(7, 

♦ LCCUI12),LENU(12),NU,NEETA,NLAM,NE0 

COMMON /VECTOR/ 

♦ Yf250),YDT(250) 

C 

01 MENS ION DFC3) ,ANGF(3) ,ROTF( 3,3),RH(3,3), 

♦ 1T0PW12, 5),I0P(2, 5),NP0DFC 5) 


105 


106 


125 


-006787 
-006768 
-006789 
006790 
-006791 
006792 
006793 
206794 
006795 
406796 
006797 
1306798 
006799 
1606800 
1706801 
5), 1806802 
1906603 
006804 
2006805 
006606 
006807 
8106808 


115 


DATA 1 1ST, NOT / 0, 6/ 

006809 

006810 

IF (IlST .FQ. 1) GO TO 500 

006811 

006812 

11 ST = 1 

006813 

DO 105 1=1,2 

006814 

DO 105 J=1,NH 

006615 

1T0PW<I,J) = ITOPOL<I,J) 

006816 

IS = 1 

006817 

DC 106 N=1,NB 

006818 

NBODF(N) = 0 

006819 

IT0PW(1,1) = 0 

006820 

NOP = 1 

006821 

I0P(1,1) = 1 

006822 

I0P{2,1) = 1 

006823 

DO 110 1=1,2 

006824 

DO 110 J=1,NH 

006825 

IF (ITOPW(I,J) .NE. IS) GO TO 110 

006826 

NOP = NOP + 1 

006627 

10P(1,J) = NOP 

006828 

I0P<2,J) = ITOPWa.J) 

006829 

IF (1 -EO. 2) GO TO 115 

006830 

IOP(l,J) = -NOP 

006631 

I0P(2,J) = ITCPW(2,J) 

006832 

ISl = I0P<2,J) 

006833 

NBOOFCISl) = 1 

006834 

1T0PW(1,J) = 0 

006835 

IT0PW(2,J) = 0 

006836 
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110 CONTINUE 

NBODFfISI = O 

IF fNOP .EC. NH> GO TO 120 

00 116 N=1,NB 

IF INBODFINI .EO. O) GO TO 116 
IS = N 
GO TO 125 
116 CONTINUE 
GO TO 999 
120 DO 130 J=1 ,NH 
JOPA = lOPd.JI 
JOP = IABS(J0PAI 
1T0PWI1,J0P> = ISIGN(JOPAtJ) 

130 lTOPH(2tJOP> = I0Pf2»J) 

C 

500 CONTINUE 

NBET = L0CU(2*NB +11-1 
DO 5 J = 1,NH 
DO 5 l=lt6 
II - I + 1 

IF (IHDATAdltJ) .EQ. 1) 60 TO 5 
NBET = NBET ♦ 1 
BETAHdtJI = YCNBETI 
5 CONTINUE 
C 

DO 10 1=2, NH 
NOBQ = ITOPOLCl,!) 

NOBP = ITDP0L(2,I) 

LRl = 1 + 6*11-2) 

LDl = 1 ♦ 7*11-2) 

LR2 = LRl ♦ 1 
LR3 = LRl + 2 
LR4 = LRl + 3 
LR5 = LRl + 4 
LR6 = LRl ♦ 5 
LD2 = LOl ♦ 1 
L03 = LDl * 2 
LDA^ = LDl + 3 
LOS = LDl + 4 
L06 = LDl + 5 
LOT = LDl + 6 
N«0 = IRGFLXfNOBQ) 

NMP = IRGFLX(NOBP) 

IF INMO .EO. 0) GO TO 15 
LU = LOCU(NOBQ+NB) 

LHS = 2*1 - 3 

CALL MULT3 (HATH* 1, 1 , LHS ) ,Y( LU) ,DF,3,NM0, 1,3,1, 1) 
CALL MULT3 f SIGH( 1 , 1 ,LHS ) ,Y( LU) ,ANGF,3 ,NM0,1,3,1 , 1 ) 
CALL ROTTR (3,1 ,ANGF,ROTF,OUH,DUM ) 

CALL MULT3 (ROTF,RHI 1 ,1,LR1) ,RH( 1,1 ,LR3) ,3 ,3,3,3 ,3,3 ) 


i 

1 

li 




006837 

006838 

006639 

006840 

006841 

006842 

006643 

006644 

006845 

006646 

006847 

006848 

006849 

006850 

006851 

006652 

006853 

006654 

006855 

006856 

006857 

006858 

006659 

006860 

006861 

006862 

006863 

006864 

006865 

006866 

006867 

006868 

006869 

006870 

006871 

006872 

006873 

006874 

006875 

006876 

006877 

006878 

006879 

006880 

006881 

006882 

006883 

006884 

006885 

006886 



I 
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DO 12 J=l»3 006887 

12 0H(J,LD3) - DH(J,LD1) ♦ DF(J) 0068P8 

006889 

16 IF (NMP .FO. 0) GO TO 20 006890 

LU = LOCU(N:OBP+»iB) 006891 

LHS = 2*1 - 2 006892 

CALL MULT3 (HATH ( I , 1 , LHS ) » Y( LU ) ,DF,3 tNMP ,1 ,3 , 1 , 1 ) 006893 

CALL MULT3 ( S IGH ( 1 , 1 , LHS > , Y( LU ) , ANGF, 3 ,NMP , 1 ,3, 1 , 1 ) 00689A 

CALL ROTTP (3 ,1 ,ANGF,ROTF,OUM ,DUK ) 006895 

CALL MULT3 C RUTF,RH( 1 ,1 ,LR2) ,RH( 1 ,1 ,LR4) ,3 t 3,3,3 ,3,3 ) 006896 

00 17 J=l,3 006897 

17 DH(J,LD4) = DH(J,LD2) + DF(J) 006698 

006899 

20 DO 25 J=l,3 006900 

JP3 = J + 3 006901 

ANGF(J1 = FFTAH(J,I) v006902 

25 DH(J,Ln5) - BETAHtJP3,I) 006903 

IT = IHDATA(1,I) 006904 

CALL RCTTR ( 3 ,I T, ANGF ,RH ( 1 , 1 ,LR5 ) ,OUM , DUM ) 006905 

CALL P 0 T 1 P (l,IT,ANGF,PlN{l,l,n,RP2(l,l,I),RP3(l,l,IJ) 006906 

00 35 L=l,3 006907 

DO 35 J=l,3 006908 

35 RW(L,J) = RH(j,L,LR3) 006909 

CALL MULT3 (RHIl , 1 , LR4) ,RH(1 , 1 ,LR5) ,R0TF,3 ,3,3,3 ,3,3 ) 006910 

CALL MULT3 ( ROTF , RW ,RH ( 1 , 1 ,LR6) , 3 ,3 ,3, 3,3,3 ) 006911 

CALL MULT3 (RH( 1 , 1 , LR4» ,DH (1 ,LD5 » ,DF,3 ,3,1 ,3 ,3,1 > 006912 

CALL MULT3 (RH( 1,1, LR6) ,DH ( 1 ,LD3 ), ANGF ,3,3 , 1 ,3,3 , 1 ) 006913 

DO 40 J=l,3 006914 

40 DH(J,LD6) = 0Hrj,LD4) + OF(J) - ANGF(J) 006915 

006916 

10 CONTINUE 006917 

006918 

DO 45 J=l,3 006919 

JP3 = J ♦ 3 006920 

D0L(J,1) = BETAHCJP3,1) 006921 

45 ANGF(J) = PETAH(J,1) 006922 

IT = 1HDATA(1,1) 006923 

CALL ROTTR (3 ,IT, ANGF ,ROL( 1, 1 ,1 ) ,DUM,OUM) 006924 

CALL RCTTR ( 1, IT, ANGF ,PIN ( 1 ,1 ,1 ) ,RP2( 1 , 1,1 ) ,RP3f 1 , 1,1 H 006925 

006926 

DO 50 J=2,NH 006927 

NOH = IT0PH(1,J) 006928 

LROJ = IT0PW(2,J) 006929 

IF (NOH .LT. 0) GO TO 52 006930 

LR6 - 6* (NOH - 1) 006931 

LRO *= IT0P0L(2,N0H) 006932 

CALL MULT3 (ROL (J ,1 ,IR0) , PHI 1 ,1 ,LR6J ,R0L(1 ,1 ,LROJI ,3 ,3,3 ,3,3,31 006933 

GO TO 50 006934 

52 NOH = -NOH 006935 

LR6 = 6*(N0H - 1) 006936 


LRO = ITOPOLfl.NOH) 006937 

DO 53 1=1,3 006938 

DO 53 L=l,3 006039 

53 RW(I,U = RHCL,I,LR61 006940 

CALL MULT3 f ROLC 1 , 1 ,LRO I ,RW ,ROL 1 1 , 1 , LRO J) ,3 ,3,3,3 ,3,3 I 006941 

50 CONTINUE 006942 

C 006943 

DO 60 J=2,NH O06944 

LRO = lT0PnLC2,J) 006945 

LD6 = 70(J-1) - 1 006946 

LD7 = LD6 + 1 006947 

60 CALL MULT3 ( ROL f 1 ,I ,LR0) ,DH( 1 ,LD6) ,DH ( 1 , LD7) ,3,3 ,1 ,3,3,3 ) 006948 

C 006949 

DO 70 J=2,NH 006950 

NOH = IT0PMC1,J> 006951 

LOOJ = IT0PW(2,J) 006952 

IF (NOH .LT. 0) GO TO 72 006953 

LD7 = 7*(N0H - 1» 006954 

LOO = lT0PnLI2,N0H) 006955 

DO 74 1=1,3 006956 

74 D0L(I,LD0J> = DOL(I,LDO» + DH(I,L07) 006957 

GO TO 70 006958 

72 NOH = - NOH 006959 

LD7 = 79(N0H - 1) 006960 

LDO = ITOPOLn,NOHI 006961 

DO 73 1=1,3 006962 

73 DOLCI,LDOJ) = OOL(I,LDO) - DH(I,LD7) 006963 

70 CONTINUE 006964 

C 006965 

RETURN 006966 

C 006967 

999 WRITE (NOT, 2001) 006968 

2001 FORMAT (1H1,22HT0PDL0GY ERROR, ITOPDL) 006969 

STOP 006970 

C 006971 

END 006972 
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fHOGfP ROTDS 
[FORtIS ROTDS 

COMPILFR ( XM = 1)» (EOUIV=:CMM) 

SUBROUTINE ROTDS 

IMPLICIT DOUBLE PR EC IS ION I AHH »D-Z ) 

C 

COMMON /hands / 

♦ HATH(3, 6, e»,SlGH(3, 6t 8)fHATS(3, 6 , 10 ) t SIGS f 3 , 6,10) 

COMMON /SPECIF/ 

♦ BETAH(6, 5) ,BETAHD(6t *5) tAM0(2, 5 > .RH( 3 t 3^24 ) ^RS ( 3 t3 »20 ) ♦ 

♦ DHC3,28 ) tDS(3t20) ,IM0(3f 15)»NMOW(5, 5 1 » IFTSMW (10 ) , 

^ NEtNHfNSPT,NOFMG,NDELTAf IT0PDL(2t 5),IRGFLX( 5),IHDATAC7, 

LOCU( 12 » tLENU(12) ,NUtNBETA tNLAMtNEO 
COMMON /VECTOR/ 

^ Y(250 ),Y0T(250» 

C 

DIMENSION nF(3),AF(3) tRF(3t3) 

C 

DO 10 L=1,NSPT 
NOB ~ IFTSMWd I 

IF (IRGFLX(NOB) .EC. 0) GO TO 10 
LRl = 2^L 1 

LR2 = LRl 1 

LO = LOCU(NE^NnB) 

LE = L ENU ( NB-i^NOB ) 

CALL MULT3 (H ATS ( 1 , 1 »L ) >Y ( LO ) ,DF , 3, LE » 1 ,3f 1 f 1 1 
CALL MULT3 (SIGS (1 t 1 t U tY(LO) ,AFf 3»LEf 1»3,1 tl ) 

CALL ROTTR ( 3 , 1 ♦ AF ,RF»DUM ,DUM ) 

CALL MULT3 (RF,RS Cl tl f LRl) ,RSC1 ,1 ,LR2) »3,3 ,3»3t3 ,3) 

DO 15 1=1 » 3 

15 0S(I,LR2) = DS(I,LR1) + DFCIJ 
C 

10 CONTINUE 
C 

RETURN 

END 


^006973 
“006974 
“006975 
006976 
“006977 
006978 
006979 
406980 
0069 ei 
1606962 
1706983 
5)f 1806964 
1906985 
006986 
2006967 
006968 
006969 
006990 
006991 
006992 
006993 
006994 
006995 
006996 
006997 
006998 
006999 
007000 
007001 
007002 
007003 
007004 
007005 
007006 
007007 
007008 


oooonooonoooo 
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[HOGfP ROTTR 
[FOR, IS ROTTR 

COMPILFR CXM=1),CEQUIV=CMN) 

SUBROUTINE ROTTR ( 123. IT¥PE*ANG,RCT,RP2 ,PP3 ) 

IMPLICIT DOUBLE PREC ISIONC A--H .0-Z > 

OIMENSIONf ANGf 1) fR0TC3.3) » RP2C3»3>. RP3(3»3) 

DIMENSION IP(36) ,AI3,3fA) .IV(3) 

COMMON /NUMBRS/ 

* ZROfONE.TWO.TRES 

SUBROUTINE TO COMPUTE 12 TYPES OF EULER ANGLE TRANSFORMATIONS 
AND/OR PI INVERSE TRANSFORMATIONS, 

ALSO IF 123 •FC. 1. COMPUTE RP2 AND RP3 WHICH MULTIPLY 

D/DTITHETAC?)) AND D/DTC THETA (3 ) ) TO FORM 0/0T(PI INVERSE). 
123 = (1 IF POT = PI INVERSE). = (3 IF ROT = ROT. TRANS.) 

ITYPE = 1.2... 12 (TYPE OF EULER ANGLE PERMUTATION, SEE IP BELOW) 
ANG = INPUT EULER ANGLES 
ROT = EITHER PI INVERSE OR ROT. TRANS. 

COOED PY CARL BODLEY. NOV. 20, 1973, 

ADDITIONS MADE BY CARL BODLEY. APR. 5. 1 97A 


LI = 3*( ITYPE 1) 

DO 15 L-1.3 
IV(L) = 1 
DO 10 1=1,3 
DO 5 J=1.3 
5 A( I,J,L) = ZRO 
10 A(I,I,L) = ONE 
15 CONTINUE 

LR =4-123 
DO 20 L=LR ,3 
K = IP(L1 + L) 

S = DSIN(ANGCD) 

C = OCPS(ANC(L)) 
GO TO (1.2 .3). K 


A(2,2,L) 
A(3.3.L) 
AC 2.3,L) 
A(3.2.L) 
GO TO 20 
A( 1.1. L) 
A(3.3.L) 


C 

C 

-s 

s 

c 

C 


-007009 

-007010 

-007011 

007012 

-007013 

007014 

007015 

007016 

007017 

007018 

007019 

007020 

007021 

007022 

007023 

007024 

007025 

007026 

007027 

007028 

007029 

007030 


DATA 

IP / 

1,2,3, 

1,2,1 , 

1 . 3 f 1 1 

1,3,2, 

007031 

♦ 


2,3,1, 

2,3,2, 

2,lf2, 

2,1,3, 

007032 

♦ 


3,1,2, 

3,1,3, 

3.2.3. 

3,2,1 /, 

007033 

* 

NOT, 

FPS / 6, 

1.0-08/ 



007034 


007035 

007036 

007037 

007038 

C07039 

007040 

007041 

007042 

007043 

007044 

007045 

007046 

007047 

007048 

007049 

007050 

007051 

007052 

007053 

007054 

007055 

007056 

007057 

007058 


61 


A(1,3,L) = £ 

A(3,1,L) = “S 
GO TO 20 
3 A( ItlfU = C 
A(?t2tL) = C 
A(1»2»L) = --S 
A(2»lfL) ~ £ 

20 CONTIMUE 

IF (123 .EC. n GO TO 50 
C 

CALL MULT3 ( A ( 1 1 1 1 1 ) t A ( 1 9 1 1 2 ) t A ( 1 1 1 ,4) t3 13 ,3 ,? »3 »3 ) 
CALL MULT3 ( A C I * 1 14 ) t A (1 9 1 13 ) »FOT ,3 13 » 3,3 f 3 »3 J 

RETURN 


50 DO 25 1=2,3 

II = TP(L1 + I) 

25 rV(Il) = I 

£2 = D£IN( ANG(2) ) 

C2 = DCGS( ANG(2) ) 

II = FL0AT(TTYPE)/4.2 
K = ITYPF -- 4#11 
GO Jn (61,62 ,63,64), K 

61 IF (DABSCC?) .LT. EPS) GO TO 9<>9 
AL = C2 

AL2 = AL*AL 
BE = S2 
ALP = S2/AL2 
BEP = -0NF/AL2 
GO TO 65 

62 IF (DABS (C 2) .L7. EPS) GO TO 999 
AL = S2 

AL2 = AL^AL 
BE = C2 
ALP = -^C2/AL2 
BEP = 0NE/AL2 
GO TO 65 

I 63 IF CDABS(C2> .LT. EPS) GO TO 999 

AL = ~S2 
AL? = AL»AL 
BE = C2 
ALP = C2/AL2 
BEP = -0NE/AL2 
GO TO 65 

64 IF I DABSCC 2) .LT. EP£J GO TO 999 
j AL = C2 

AL2 = AL^AL 
BE = -S2 
ALP = S2/AL2 
BEP = 0NE/AL2 



007059 
007060 
007061 
007062 
00*^063 
007064 
007065 
007066 
007067 
007068 
007069 
007070 
007071 
007072 
007073 
007074 
007075 
007076 
007077 
007078 
007079 
007080 
007081 
007082 
007083 
007084 
007085 
C 070 86 
007087 
007088 
007089 
007090 
007091 
007092 
007093 
007094 
007095 
007096 
007097 
C07098 
007099 
007100 
007101 
007102 
007103 
007104 
007105 
007106 
007107 
007108 



65 

K = IPCLl+3) 

007109 


GO TO (71,72 t73) , K 

007110 

71 

A(2,2,l) = A(2,3,3) 

007111 


A(3,3,l) = A(2,3,3) 

007112 


A(3,2,l) = A(2,2,3) 

007113 


A(2,3,l) = -A(2,2,3) 

007114 


A (1,1,1) = ZRC 

C07115 


GO TO 75 

007 1 16 

72 

A(1,I,I) = A(3,l,3) 

007117 


A(3,3,l) = A(3,l,3) 

007118 


Ad, 3,1) = Ad, 1,3) 

007119 


A(3,l,l) = -A(l,l,3) 

007120 


A(2,2,l) = ZRO 

007121 


GO TO 75 

007122 

73 

Ad, 1,1) = Ad, 2, 3) 

007123 


A(2,2,l) = Ad, 2, 3) 

007124 


A(2,l,l) = Ad, 1,3) 

007125 


Ad, 2,1) = -Ad, 1,3) 

007126 


A(3,3,l) = ZRO 

007127 

75 

DO 80 1=1,3 

007128 


11 = IV(I) 

007129 


DO 80 J=l,3 

007130 


A(I1,J,2) = Ad,J,l) 

007131 

80 

Adl,J,4) = A(T,J,3) 

007132 

007133 


DO 90 J=l,3 

007134 


ROT(l,J) = A(1,J,4)/AL 

007135 


RP3d,J) = A(1,J,2)/AL 

007136 


ROT(2,.n = A(2,J,4) 

007137 


RP3(2,J) = A(2,J,2» 

007138 


ROT(3,J) = A(3,J,4) - BE*R0T(1,J) 

007139 


RP3(3,J) = A(3,J,2) - EE*PP3(1,J> 

007140 


RP2(1,J) = ALP*A(1,J,4) 

007141 


RP2(2,J) = ZRO 

007142 

90 

RP2(3,J) = REP*A(1,J,4) 

007143 

007144 


RETURN 

007145 

999 

WRITE (NOT ,1000) 1TYPE,ANG(2) 

007146 

1000 

FORMAT dHl,2ZMGIMBAL LOCK — ITVPE = ,I5,8HANGLE = ,D15.8) 

007147 


STOP 

007148 


END 

007149 


183 


tHDGfP RTPP 
rPORtlS PTOP 

CCMPILFR (XM=1), (FOUIV=CMN) 

SUBROUTINE P.TOP (RTS , POLY »TEMP,KPLY) 

IMPLICIT DOUBLE PR EC I S ION ( A-H tO-Z ) 

CRTOP TRANSFER FUNCTION ROOTS TO TRANSFER FUNCTION POLYNOMIALS 

C 

C SU8ROUT1NF RTOP, ROOTS CONVERTED TO POLYNOMIAL 

C 

C — RTS(l) = NUME'ER OF REAL ROOTS IN THE NUMERATOR 

C RTSC?) = NUMBER OF COMPLEX PAIRS IN THE NUMFRATOR 

C RTS(3) = NUMBER OF ZERO ROOTS IN THE NUMERATOR 

C PTSI4) = NUMBER OF REAL ROOTS IN THE DENOMINATOR 

C RTS (5) = *niMBFR OF COMPLEX PAIRS IN THE DENOMINATOR 

C — - RTS(6> = NUMBER OF ZERO RQOTS IN THE DENOMINATOR 
C RTSI7) = GAIN FACTOR 

C RTSC8) ...RTS(I) = NUMERATOR REAL ROOTS ARRAY 

C PTS(I+1)...RTSIJ) = NUMERATOR COMPLEX ROC3TS ARRAY 

C RTS( J+1 ) .RTS(K) = DENOMINATOR REAL ROOTS ARRAY 

C RTS(K+1).. .RTS(L» = DENOMINATOR COMPLEX ROOTS ARRAY 

C POLY(l) = DEGREE OF THE NUMERATOR 

C POLY(2I != DEGREE OF THE DONOMINATOR 

C POLY(3).,.POLY{I) = ALL COEFFICIENTS OF NUMFRATOR FOR ASCENDING PO 

C POLY(I+l>. ..POLY(J) = ALL CCEFFICIFNTS OF DENOMINATOR FOR ASCENDIN 

C -™- OF S 

C TEMP = TEMPORARY STORAGE 

C NCD = NUMBFR OF COMPLEX PAIRS IN DENOMINATOR 

C NCN = NUMBER OF COMPLEX PAIRS IN NUMERATOR 

t NOEN = TOTAL NUMBER OF DENOMINATOR ROOTS IN RTS ARRAY 

C NNUM = TOTAL NUMBER OF NUMERATOR ROOTS IN RTS ARRAY 

C r: number OF REAL ROOTS IN THE DENOMINATOR 

C nRN = NUMBER OF REAL ROOTS IN THE NUMERATOR 

C NZO = NUMBFR OF ZERO ROOTS IN THE DENOMINATOR 

C N2N = NUMBER OF ZERO ROOTS IN THE NUMERATOR 

C KPLY = DIMENSION SIZE OF POLY IN CALLING PROGRAM. 

C 

DI MENS ION RTS ( 1 ) , POL Y ( 1 ) , TEMP ( 1 1 
KTAPE = 6 
NRN=RT5(1) ♦ O.IDO 
NCN=RTS(2) O.IDO 
NZN=RTS(3) + O.IDO 
NRD=RTS(4) ♦ 0.100 
NCD=P.TS(5) ♦ O.IDO 
NZD=RTS(6) + O.IDO 
DO 100 I = 1,KPLY 
POLYCI )=0.D0 
100 TEMP(I) = O.DO 
C 

NNUM = 2 ♦ NCN + NRN + NZN 
NOEN = 2 * NCD + NRO + NZO 


-007150 
-007151 
-007152 
007153 
-007154 
007155 
007156 
007157 
007158 
007159 
007160 
007161 
007162 
007163 
007164 
007165 
007166 
007167 
007168 
007169 
007170 
007171 
007172 
007173 
007174 
007175 
007176 
007177 
007178 
007179 
007180 
007181 
007182 
007183 
007184 
007185 
007186 
007187 
007188 
007189 
007190 
007191 
007192 
007193 
007194 
007195 
007196 
, 007197 
007198 
007199 
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POLYf 1»=NNUM 
POLY|2)=NDEN 


KP = O 

POLY (31 = 1.00 
IF CNRN) 510, 110, 130 
110 IF (NCW) 510, 120, 190 

NUMERATOR IS GAIN TERM ONLY 
120 KP = NZN + 3 
P0LYC3I = O.DO 
POLYCKP) = PTS<7> 

KP = KP+1 
GO TO 290 

NUMERATOR REAL ROOTS 
130 TEMP (21 = RTS (8) 

POLY (4) = TEMP 12) 

IF (NRN-1) 180, 180, 140 


POLY IKl+2) 


POLY IKl+3) 


POLY (4) = TEMP 121 
IF (NRN-1) 180, 180, 1^ 
140 DO 170 K = 2, NRN 
DO 150 K1 = I, K 
150 TEMP CKl+1) = RTSfK+7) 
DO 160 K2 = 1, K 
160 POLY (K2+3) = TEMP (K2- 
170 CONTINUE 

180 IF (NCN) 510, 250, 190 


INCLUDE THE NUMERATOR COMPLEX ROOTS 
190 KNR = NRN 
KC = NRN +8 
KCM = 2 * NCN + KC - 1 
DO 240 L = KC, KCM, 2 
TEMl = 2.00=frRTSfL)/RTS(L+l) 

TEH2 = l.D0/RTS(L+l)«2 
LL = L-6 

DO 220 L2 = 1, LL 
TEM3 =0.00 

IF CL2-1) 210, 210, 200 
200 TEM3 = TEM2 * POLY (L2+1) 

210 TEMPCL2+1) = POLY (L2^3) + TEMl ♦ POLY (L2+2) 
220 CONTINUE 

KNR = KNR + 2 
DO 230 L3 = 1, KNR 
230 POLY (L3+3) = TEMP (L3+1) 

240 CONTINUE 


TEM3 


ENTER GAIN FACTOR, ZERO RL3TS, RESTORE COEFFICIENTS 
250 KP = NZN ♦ 4 

KS = 2 * NCN + NRN 

DO 260 J = 1, KS, 1 

POLY (KP) = TEMP (J+1) * RTS (7) 


o o o o 
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260 KP = KP-U 007250 

POLY (NZN+3) I.DO» RTS (7) 007251 

IF INZN) 2‘>0, 290t 270 007252 

270 DO 280 J = 1, NZN, 1 007253 

2P0 POLY (J+2» = O.DO 007254 

007255 

PROCESS DENOMINATOR ROOTS, KP IS LOCATION FOR STORING FIRST 007256 
DENOMINATOR COEFFICIENT 007257 

007258 

290 POLY (KP) = 1.00 007259 

IF (NRD) 510, 300, 340 007260 

300 IF (NCO) 510, 310, 400 007261 

C DENOMINATOR RFAL ROOTS < KR IS LOCATION FOR FIRST ROOT) 007262 

310 IF (NZD) 510, 500, 320 007263 

320 KRIP = KP + NZD 007264 

DO 330 15 = KP,KRIP 007265 

P0LY(I5) =0.D0 007266 

330 CONTINUE 007267 

POLYCKRIP) = l.DO 007268 

(;0 TO 500 007269 

340 KR = 2*NCN * NRN + 8 007270 

P0LY(KP+1) = RTS(KR) 007271 

TFMP(2) = RTSIKR) 007272 

IF CNR0“1) 390, 390, 350 007273 

350 DO 380 K=2,NR0 007274 

NCI = KR+K-1 007275 

DO 360 K1 = 1,K 007276 

NC2 = KP+Kl-1 007277 

360 TEMP(K1+1) = KTS(NC1)*P0LY(NC2) ♦ PPLY(NC2-H) 007278 

DO 370 K2 = 1,K 007279 

NC3 = KP+K2 007280 

370 POLY(NC3) TEMP(K2+1) 007281 

380 CONTINUE 007282 

C 007283 

390 IF (NCD) 510, 460, 400 007284 

C 007285 

C PROCESS DENOMINATOR COMPLEX ROOTS 007286 

400 KDR = NRD 007287 

KC = 2*NCN + NRN + NRD +8 007288 

KCM = 2 * NCD + KC-1 007289 

DO 450 L = KC, KCM, 2 007290 

TEMl = 2.D0*RTS(L)/RTS(L+1) 007291 

TEM2 = 1 .DO/RTS (L+1 )»72 007292 

LL= L-(2*NCN+NRN+6) 007293 

00 420 L2 = 1, LL 007294 

NC5 = KP+L2-1 007295 

TEM3 - O.DO 007296 

IF (L2-1) 420, 420, 410 007297 

410 TEM3 = TEM2 ♦ POLY CNC5-1) 007298 

420 TEMP (L2+1) = POLY (NC5+1) + TEMl ♦ POLY (NC5) ♦ TEM3 007299 


jCf 


I 

I 
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430 CONTINUE 007300 

KOR = KDR ■* 2 007301 

DO 4A0 L3 = 1» KDR 007302 

NC6 = KP+L3 007303 

440 POLY CNC6) = TEMP (L3+1 ) 007304 

450 CONTINUE 007305 

C 007306 

460 KD = KP ♦ N2D ♦ 1 007307 

KS = 2 ♦ NCD ♦ NRD 007308 

DO 470 M = l» KS, I 007309 

POLY <KD) = TEMP (M+1) 007310 

470 KO = KD+1 007311 

KD = KP+NZD-1 007312 

POLY CKD+1) = POLY (KP» 007313 

IF INZO) 500, 500, 480 007314 

480 DO 490 J = KP, KD, 1 007315 

490 POLY (J) = 0.00 007316 

C 007317 

500 RETURN 007318 

C ERROR COMMENT AND RETURN TO MAIN PROGRAM 007319 

510 WRITE CKTAPE, 10021 007320 

1002 FORMAT I86H1 A NEGATIVE COUNT OF ROOTS WAS ENCOUNTERED IN RTOP . PO 007321 

ILYNOMIAL COULD NOT BE OBTAINED.) 007322 

RETURN 007323 

END 007324 




ooonooononooonoonoo 


.f 

i 
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fHDGtP RWRITE 
[FOR, IS RWRTTE 

COMPILER ( XM-J {FQUIV=CMN) 

SUBROUTINE RWRITF (K »RR1 ^R I 1 ,PR ?,RI2 ,N1 ,N2 t ANAMl , ANAM2 ) 
IMPLICIT DOUBLE PR EC I S ION « A-H » 0~Z I 

SUBROUTINE PULLS UP MEW PAGE VIA PAGEHD, PRINTS OUT 

IDENTIFIC ATTCN«S) , ANAMl AND ANAM2» THEN PRINTS ROOTS. 


-SUBROUTINE ARGUMENT DESCRIPTIONS 


DIMENSION PPICI), RIl(l), RR2(1), RI2(1) 
DATA NOT / 

6 / 


-00732S 

-007326 

-007327 

007328 

-007329 

007330 

007331 

007332 

007333 

007334 

007335 




ALL ARGUMF^^TS ARE INPUT 

007336 




007337 

K 


NO. OF ROOT SETS TO PRINT. 

007338 

PRl 


REAL ROOTS (FIRST SET) 

007339 

RIl 


IMAG ROOTS (FIRST SET) 

007340 

RR2 

=. 

REAL ROOTS (SECOND SET) 

007341 

RI2 


IMAG ROOTS (SECOND SET) 

C07342 

N1 


ROOT COUNT (FIRST SET) 

007343 

N2 

=: 

ROOT COUNT (SECOND SET) 

007344 




007345 

ANAMl 


A CHAP ACTE® ALPHANUMERIC TITLE (FIRST SET) 

007346 

ANAM2 


A CHARACTER ALPHANUMERIC TITLE (SECOND SFT) 

007347 


107 FORMAT ( // /20X,A4.,34Xit A4t//5X ,2HN0,5X,9HPEAL PART « 

1 3X *14H1MAGINARY PART, 1 IXt^HRE AL PART,3X, 14H2MAGINARY PART, 

2 //) 

102 FORMAT ( 5X , I 2 , 3X ,D12 .5 , 5X ,D 12 .5 ,9X ,D 12 .5,5X ,012.5 ) 

103 FORMAT ( 5X , 1 2 ,41 X, D1 2 . 5 ,5X , 01 2 .5 ) 

CALI PAGFHD 
IF (K .EO. 2) GO TO 20 
WRITE (NOT, 101) ANAMl 
DO 10 1:^1, N1 

IF (I .GT. 50) CALL PAGEHD 
IF (I .GT. 50) WRITE (NOT, 101) ANAMl 
10 WRITE (NOT, 102) I,RR1(I), RIl(I) 

RETURN 
20 CONTINUE 

L == MAX0(N1,N2) 


007348 

007349 

007350 

C07351 

007352 

007353 

007354 

007355 

007356 

007357 

007358 

007359 

007360 

007361 

007362 

007363 

007364 

007365 

007366 

007367 

007368 

007369 


WRITE 

(NOT 

,101) 

ANAMl* ANAM2 



007370 

DO 

40 

I=l» 

L 




007371 

IF 

(I 

.GT. 

50) 

CALL PAGEHD 



007372 

IF 

(I 

.GT. 

50) 

WRITE (NOT, 101) 

ANAMl, 

ANAM2 

007373 

IF 

(I 

• GT . 

N1 

.OR. I, .GT. N2I 

GO TO 

30 

007374 


WRITE 

INOT 

• 1021 

!• RR1(I1*R11( 

n,RR 2 ( 

GO TO 

40 





30 COMTINUE 





IF II 

.GT. 

N?) 

WRITE 

(NOT, 1021 

I» RRl 

IF (1 

.GT. 

Nil 

WRITE 

INOT ,1031 

If RR2 


40 CONTINUE 


RETURN 

END 


11 ,R 12 1 11 

007375 


007376 


007377 

m, Riim 

007378 

m, R 12 111 

007379 


007380 


007381 


007382 


007383 


tHDGt^- SATB 
[FOR, IS SATB 

CCMPILFR (XM=1)» (FOUTV^CMN) 

SUBROUTINE S ATB C S , A, B t Z »NPA ,NCA ^NCB *KR A t KRB »KR Z ) 
IMPLICIT DOUBLF PRFCISION(A-HtO-‘2 ) 

C T 

C MATRIX PRODUCT Z(NEW) = Z(OLD) S’^A 


WHERE 


SCALAR 

INPUT 

INPUT 

OUTPUT 


(NRA,NCA) 

(NRAfNCB) 

(NCA,NCPI 


DIMENSION A(KRA,1 ) tB ( KRB , 1) ,Z ( KRZ 1 1 ) 
C 

DO 20 1=1, NCA 
DO 20 J=1,NCB 
DO 20 K = 1,WA 

20 Z(I,J) = Z(I,J) + S^ACK,I)*B(K,J) 

C 

RETURN 

END 


4 4 
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-007384 

-007385 

-007386 

007387 

-007388 

007389 

007390 

007391 

007392 

007393 

007394 

007395 

007396 

007397 

007398 

007399 

007400 

007401 

007402 

007403 

007404 



on on 


1 
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[HDGfP SFRE02 
[FORtIS SFRE02 

COMPILER ( XH=^1),(E0UIV=^CMN) 

SUBROUTI W SFREQ2 (NMR t ICN ,N0 R» ICO ,GAIN , 

1 FBRM,FBNC»FeR 9 FPDC « 

2 FMINfFMAX, TITLE) 

C 

IMPLICIT OeiJBLF PRECISION (A-HtC-'Z) 

REAL SAVED, SAVEP, SAVED, SAVEA 

REAL FHIN , FMaX , TITLE 

C 

C SUBROUTINE DETERMINES S--PLANE FREQUENCY RESPONSE 
C USING VARIABLE INCREMENTING TECHNIQUES. 

C 

C FREQUENCY RESPONSE SAVED IN COMMON BLOCK /PSTUFF/ 

C 

C SUBROUTINE ARGUMENT DESCRIPTIONS 

C 

C NNR INPUT NUMERATOR REAL ROOT COUNT. 

C ICN = INPUT NUMERATOR CCMPLES PAIR ROOT COUNT. 

C NDR = INPUT DENOMINATOR REAL ROOT COUNT- 

C ICD = INPUT DENOMINATOR COMPLES PAIR ROOT COUNT. 

C GAIN = INPUT BODE GAIN. 

C FBRN = INPUT NUMERATOR REAL ROOTS f INCLUDING ZEROS). 

C FBNC = INPUT NUMERATOR COMPLEX PAIRS. 

C FBR = INPUT DENOMINATOR REAL ROOTS (INCLUDING ZEROS). 

C FBDC - input denominator COMPLEX PAIRS. 

C TITLE == INPUT 80 CHARACTER ALPHANUMERIC TITLE. 

C 

COMPLEX PROD, FOEN , FNUM ,OCMPLX 

DIMENSION FBRN (1) , FBNC (1) , FBP (1) , FBDC (1) , 

1 TITLEd) , WD(107> , TABGC20) , TAEUPOl), 

2 TABZOO) ,TABDN(31) , PROD(l) , 

3 FNUMI SO), EOEN( 50) 

COMMON /PSTUFF/ 

♦ SAVED(500), SAVEP(500), SAVF0(50D>, SAVEAC500), 

COMMON /KDSIZE/ 

1 KR, KRT, KRX, KVI, KV2, KVX 

COMMON / LVl / 

C VI ( 50), V2 ( 50), V3 ( 50) 


DATA KWD/107/ 

DATA KDSAVE/500/ 

DATA NOT/ 6 / 

TABG = GROSS CONSTANT TABLE 

DATA KTABG ,KTABUP ,KTABDN/18 ,31,29/ 
C 

DATA TABUP / 


-007405 
-007406 
-007407 
00740S 
007409 
007410 
007411 
-007412 
007413 
007414 
007415 
007416 
007417 
007418 
007419 
007420 
007421 
007422 
007423 
007424 
007425 
007426 
007427 
007428 
007429 
007430 
007431 
007432 
007433 
007434 
007435 
^6207436 
007437 
46407438 
007439 
KSAVE 44707440 
007441 
007442 
007443 
42607444 
007445 
007446 
46607447 
46807448 
007449 
007450 
007451 
007452 
007453 
007454 
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1 0.6OOOODO, 0«^t0000D0t 0.75000D0, 

O.BOOOODO, 0.84000DO, 

007455 


2 0.88000D0, 0.90000DOf 0.92000DO, 

0.94000DO, 0.96000D0, 

007456 


3 0.96500D0, 0.97000D0t 0.9750000, 

0.9800000, 0.9840000, 

007457 


A 0.9S80OD0, 0.O9000D0, 0.99200DO, 

0.9940000, 0.99600D0, 

007458 


5 0.99800DO, 0.9968000, 0.9995000, 

0.9997500, 0.9999000, 

007459 


6 0.9999200, 0.99994D0, 0.99996DO, 

0.99998D0, 0.9999900, 

007460 


7 1.000000/ 


007461 

c 



007462 


DATA TABG / 1.0000, 1.1000, 1.2500, 1 

.4000, 1.6000, 1.8000, 

007463 


1 2.0000, 2. 2000, 2. 5000, 2 

.8000, 3.2000, 3.8000, 

007464 


2 ^^.50D0, 5.2000, 6. 2000, 7 

.0000, 7.H0D0, 8. 9000, 

007465 


3 O.OODO, 0.0000/ 


007466 

c 



007467 

c 

TABUP LEADING UP TO THE DAMPED 

NATURAL FPEQUENCIES. 

007468 

c 



007469 


VMAX = 0.00 


007470 


POP HI = 0.00 


007471 


W1 = O.DO 


007472 

IT 



007473 


KWCT = 0 


007474 


KOPH = 0 


007475 


KPRINT = 1 


007476 


KSAVE = 0 


007477 

c 



007478 


NRN - NNR 


007479 


NCN = ICN 


007480 


NRD = NOR 


007461 


NCD = ICO 


007482 


FK = GAIN 


007483 

c 



007484 

c 



007485 


DO 110 I=1,KTAEDN 


007486 


J = KTABUP-1 


0074E7 


110 TAEDNCI) = 1 .D0/TABUP( J) 


007488 

c 



007489 

c 

TAP ON LEADING AWAY FROM 

DAMPED NATURAL FREQUENCIES 

007490 

c 

LNCTR LINE COUNTER 


007491 

c 



007492 


120 LNCTR = 40 


007493 


JX -13 


007494 

c 



007495 

c 

NULL WD 

^ / 

007496 

c 



007497 


DO 125 1= 1,KWD 


007498 


125 WD(I) = O.DO 


007499 


130 CONTINUE 


007500 


DO 140 1=1 ,KP 


007501 


FNUM(I) = (0.0,0.01 


007502 


FDENd) = (0.0,0.01 


007503 


140 CONTINUE 


007504 


? 

■ 1 . 
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FWIN =: LOWER LIMIT. 

SAVE IT AND DESTROY SAVLO IF NEEDED 
SAVLG = DBLE(FMIN) 

COMPUTE NUMERATOR DAMPED NATURAL FREQUENCIES. 


I 0 

IF (NCN) 1220, 180, 150 
150 NTOTN = NCN+2 

00 170 J=1,NT0TN,2 

ABLE = FBNCCJI ♦ FENCCJ-<^1» 

BAKER - FBNC(J41) ♦ DSORTll.DO - FBNC(J|^*2) 

TEMP = (BAKER)*^2 - UBLE)**2 
IF (TEMP) 170, 170, 160 
160 I = 1^1 

WD(I) = DSORT(TEMP) 

170 CONTINUE 

COMPUTE DENOMINATOR DAMPED NATURAL FREQUENCIES. 

180 IF (NCD) 124^0, 220, 190 
190 NTOTO NCD^2 

00 210 J=1,NT0TD,2 

ABLE - FBDC(J) ♦ FBDCfJ-H) 

BAKER = FB0C(J+1) ^ DSORTll.DO - FBDC(J)^^2) 

TEMP = fBAKER)’H'*2 - CABLE)^*2 
IF (TEMP) 210, 210w 200 
200 I - !♦! 

WD;I) == DSORT(TEMP) 

210 CONTINUE 
220 KCOUNT I 

THERE ARE KCOUNT FREQUENCIES, 

SORT THEM IN INCREASING MAGNITUDE. 

IF (KCOUNT - 1) 240, 350, 250 
240 J«1 

GO TO 370 

250 DO 270 J=l, KCOUNT 
DO 270 I=J, KCOUNT 
IF (WDfJ) .LE. WDID) GO TO 270 
TEMP = WDfJ) 

WD (J ) - WD 1 1 ) 

WD(l) = TEMP 
270 CONTINUE 


SORT COMPLETE, 

CHECK FOR EQUAL FREQUENCIES, 


007505 

007506 

007507 

007508 

007509 

007510 

007511 

007512 

007513 

007514 

007515 

007516 

007517 

007518 

007519 

007520 

007521 

007522 

007523 

007524 

007525 

007526 

007527 

007528 

007529 

007530 

007531 

007532 

007533 

007534 

007535 

007536 

007537 

007538 

007539 

007540 

007541 

007542 

007543 

007544 

007545 

007546 

007547 

007548 

007549 

007550 

007551 

007552 

007553 

007554 
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C IF SO, ELIMINATE ONE. 007555 

C 007556 

260 1=1 007557 

J = 2 007558 

C 007559 

290 IF (worn - WD(J») 300, 320, 340 007560 

300 I = I+l 007561 

J = J+1 007562 

310 IF (KCOUNT - J) 350, 350, 290 007563 

320 DO 330 K=J ,KCOUNT 007564 

WO(K-l) = WD(K) 007565 

330 CONTINUE 007566 

WD(KCOUNT) = O.DO 007567 

KCOUNT = K COUNT ~ 1 007568 

GO TO 310 007569 

340 CALL PAGEHD 007570 

WRITE (NOT, 13131 007571 

1313 FORMAT (//10X,23HTHE SORT ROUTINE FAILED / 007572 

1 10X,16HPR0GRAM STOPPED. I 007573 

STOP 007574 

350 CONTINUE 007575 

C 007576 

C 007577 

C 007578 

360 1=1 0C7579 

J = 1 007580 

IF (WD(I) .GT. 0.00) GO TO 430 007581 

370 W = TABGIJ) * SAVLO 007582 

IF (W .GT. DBLE(FMAX)) GO TO 400 007583 

IF (KTABG .GT. J) GO TO 410 007584 

SAVLO = SAVLO * lO.DO 007585 

J = 1 007586 

KK = 1 007567 

GO TO 840 007588 

C 007589 

C THE SHOW IS OVER, ’ 007590 

C GETOUT. 007591 

C 007592 

400 KK = 6 007593 

GO TO 1490 007594 

410 J = J+1 007595 

KK = 1 ,, 007596 

GO TO 840 007597 

C 007598 

C ENTRY POINT FOR LOOPING ON FREQUENCY INCREMENTING. 007599 

C 007600 

420 CONTINUE 007601 

GO TO (370, 450, 500, 610, 660, 1490 ),KK 007602 

430 IF (WD(I) .GT. SAVLO) GO TO 450 007603 

1=1+1 007604 


o o o o 
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GO TO 430 

450 IF ITABGCJI^SAVLO -- TABUP ( 1 )*WDIII I 460, 490* 490 
460 W =: TABGCJ14SAVL0 

IF CKTABG .GT. J) GO TO 480 
SAVLO =: SAVLO ♦ 10 .DO 
J = 1 
KK = 2 
GO TO 830 
480 J ~ J4^1 
KK = 2 
GO TO 830 
490 J =1 

500 IF «J ~ KTABUP) 520* 510* 530 
510 W - TABUPCJ) ♦ WOll) 

KPPINT = 2 
J = J+1 
KK = 3 
GO TO 830 

520 W == TABUPfJI * worn 
J - J + 1 
KK = 3 
GO TO 830 

530 IF CWnCI+^II .GT. O.DOl GO TO 550 

THE LAST FREQUENCY IS I* 

MAKE A DUMMY. 

woe 1+1) = FMAX ♦ TABDNCKTABDN) 

550 IF (TABUPfJX)*WO(I-H } -WDCD) 560* 640* 650 
560 J = JX 

570 IF CTA8UP( J)^WD(I + 1) -WOei)) 580* 590* 600 
580 J = J+1 
GO TO 570 
590 J = J+1 
600 1 I + I 

610 IF ((J--KTABUP) .EO. O) KPRINT 2 
IF CJ .GT. KTAPUPI GO TO 630 
620 W = TABUPC J)^WD(I) 

J J4l 
KK 4 
GO TO 830 
630 J = 1 

GO TO 530 
640 J = JX+1 
GO TO 600 
650 J = 1 

660 IF IJ .GT. KTABDN) GO TO 690 

IF (TABDN( J}*WD( I) - TABUP C JX )♦WD f I+l » ) 680* 740* 750 
680 W = TABDNf J) ♦ WDfll 
J == J+1 


007605 

007606 

007607 

007608 

007609 

007610 

007611 

007612 

007613 

007614 

007615 

007616 

007617 

007618 

007619 

007620 

007621 

00T622 

007623 

007624 

007625 

007626 

007627 

007628 

007629 

007630 

007631 

007632 

007633 

007634 

007635 

007636 

007637 

007638 

007639 

007/640 

007641 

007642 

007643 

007644 

007645 

007646 

007647 

007648 

007649 

007650 

007651 

00765? 

007653 

007654 




on o non noo 


195 


KK = 5 
GO TO 830 

690 IF (TAF.UPm*WDCr+ll - TABON(KTAEONI*WDU J) 700, 700, 760 
700 J = 1 

710 IF (TAPUPf J)*WD(T+1) - TABON(KTABDN)*WO (1)1 720, 730, 730 
720 J = J+1 

GO TO 710 
730 1 = I+l 

GO TO 610 
740 J = JX+1 
GO TO 600 
750 J = JX 

GO TO 600 

760 IF (TAPDNi KTABDN)*WD(I) - TABG(KTABG)*SAVL0) 770, 810, 820 
770 J = 1 

780 IF (TABON(KTABDNI*WO(I I - TABG(J)*SAVLO) 790, 790, 800 
790 I = 1^1 

GO TO 450 
800 J = J+1 

GO TO 780 

810 SAVLO = SAVLC ♦ 10.00 
J = 1 
1 = I+l 

GO TO 450 

820 SAVLO = SAVLO ♦ lO.DO 
GO TO 760 

830 IF (W .GT. FMAX) GO TO 1490 
840 J1 = 1 

650 IF (NPN) 1210, 910, 860 

eVALUATF NUMERATOR REAL ROOTS 

860 DO 900 I1=1,NRN 

IF (FBRN(Il) .EO. O.DOl GO TO 880 
870 FNUM(Jl) = OCMPLX(l.DO,FBRN(Il)*W» 

GO TO 890 

880 FNUM(Jl) = DCMPLX(O.DO,W) 

890 J1 = Jl+1 
900 CONTINUE 

910 IF (NCNI 1220, 940, 920 

EVALUATE NUMERATOR COMPLEX PAIRS 
920 00 930 II = 1,NT0TN,2 

REAL PART 
IMAGINARY PART 

FNUM(Jl) = DCMPLXd.DO - W**2 / CFBNC(11+1»)**2 , 

1 (2.D0* FBNC(I1)*W)/ FBNC(11+1)) 

J1 = Jl+1 
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007689 
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930 CONTINUE 

REPEAT THE ABOVE PROCEDURE FOR DENOMINATOR 

940 J1 = 1 

950 IF INRD) 1230t 1010, «»60 
960 DO 1000 I1"1,NR0 

IF (FBRdlI.EC. 0.00) GO TO 980 
FOEN(Jl) = DCMPLXfl.DO , FBR C11)*W) 

GO TO 090 

980 FOENIJl) = DCMPLX(0.D0 ,W) 

990 J1 = Jl+1 
1000 CONTINUE 

1010 IF CNCD) 1240, 1040, 1020 
1020 DO 1030 II = 1,NT0TD,2 

ALPHA = l.DO - W4*2 / I FBDC CI1+1))**2 
BETA = 2.00 * FPDC CIl) ♦ W / FBDC CIl+1) 

IF ULPHA .LT. 1.0-20 .AND. BETA .EQ. 0.00) BETA = l.OD-10 
FDENCJl) = OCHPLXC ALPHA, BETA) 

J1 = Jl+1 
1030 CONTINUE 

EVALUATE F(S) WITH COMPLEX ARITHMETIC ROUTINE. 

1040 KN = NRN+NCN 

KD = NRD+sNCD 

PROD(l) = DCMPLX (1.00, 0.00) 

IF (KN .LE. 0) GO TO 1090 
IF (KD .LE. 0) GO TO 1130 
IF (KN .GE.KD) GO TO 1110 

FACTORS IN DENOMINATOR EXCEED THOSE IN NUMERATOR. 

DO 1080 11=1 ,KN 

PROD(l) = FNUM(Il) ♦ PR00(1)/FDEN(I1) 

1080 CONTINUE 
1090 K = KN+1 

DO 1100 Il=K,KD 

PROO(l) = PR00(1)/FDEN(I1) 

1100 CONTINUE 

GO TO 1150 

FACTORS IN NUMERATOR EXCEED THOSE IN DENOMINATOR. 

1110 DO 1120 11=1, KD 

PROD(l) = FNUM(I1)*PR00(1)/F0EN(11) 

1120 CONTINUE 

IF (KN .LE. KD) GO TO 1150 
1130 K = KO+1 

DO 1140 I1=K,KN 
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007733 
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PROOm = PROOCl )*FNUK(I1 ) 

1140 CONTINUE 

115G PROO(l) = PROO(l) ♦ DCMPLXCEK.O.DO) 

EVALUATION OF FtS) IS NOW COMPLETE, 
normal computed form — FfJWI = ALPHA + BETA. 
ALPHA = PEAL PART, 

BETA = IMAGINARY PART. 

CARTESIAN FORM fX,YI 

ALPHA = OREAL fPPC'O(l)) 

BETA = DIMAG tPRCDdU 

IN POLAR FORM — FUW) = (AR.PHI). 

AR IS AMPLITUDE 
P.HI IS PHASE ANGLE 

POLAR FORM 

RED = (ALPHA^*2 ♦ BETA*#2I 
AR = OSCRT(RED) 

PHI = O.ODOO 

IFIAR .GT. O.ODOOl PHI = DATAN2(BETA, ALPHA) 

CONVERT PHI FROM RADIANS TO DEGREES. 

DPHI = PHI ♦ 57.2958D0 

IF <DPHI .LT. O.DO) DPHI = DPHI •» 360. DO 
PRINT FREQUENCY RESPONSE DATA 


SET OUTPUT PARAMETERS 

CONVERT AR TO LOG BASE 10 AND DECIBELS. 

1250 IF lAR .NE. 0.00) GO TO 1270 
EELL = -20 .DO 
GO TO 1280 

1270 BELL - DLOG(AR) 

1280 OBELL = PELL ♦ 8.68588961D0 
PHI = DPHI / 57.2958D0 
W1 = W / 6.2831853D0 
C 

1289 IF (LNCTR - 40) 1320, 1290, 1290 

1290 CALL PAGEHO 

WRITE (NOT, 158) (TITLE( 13 ) ,13=1,10) 

158 FORMAT ( /, 10X10A6 ,/) 

WRITE (NOT, 159) 

159 FORMAT ( 1HO,20X,99HFRFO/RAD/SEC FREQ/HERTZ REAL 

IMAG AMP DECIBELS RAD DEG /) 

LNCTR = 1 

IF (KPRINT .EO. 1) GO TO 1310 
KPRINT = 1 
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WRITE (NOT, 16201 W,W1 , ALPHA, BETA, AR,DBELLfPHI,DPHl 
1620 FORMAT (17H *»»****v016.6, 014.6,016.6, 014. 6,016.6, F10.3, 

1 F9.4,F10.4,9H ♦♦♦*♦♦♦♦) 

GO TO 1330 

1310 WRITE CN0T,162) W,W1 , ALPHA, BETA ,AR ,0BELL,PHI,DPH1 
162 FORMAT « 9X ,D2A .6 ,D 14.6 ,016.6, 014.6 ,016 .6, F10.3,F9.4,F10.4) 

GO TO 1370 

1320 IF (KPRINT .EO. 1) GO TO 1350 

WRITE IN0T,1620) W ,W1 , ALPHA, BETA, AR,0BELL, PHI, DPHI 
KPRINT = 1 

1330 KWCT = KWCT ♦ 1 

IF (W0(KWCT+1) .LE.O.DO) GO TO 1370 
RAT = WDCKWCTI / W0(KWCT+H 
IF IRAT .LE. 0.4200) GO TO 1370 
RAT = (1.+RATI/2.00 
JX = 2 

X =0ABSCRAT-TABUP(2) ) 

00 1340 KKK=3,30 

IF (X .LE.DABS(RAT-TABUPCKKK) )l GO TO 1370 
X =DABS(RAT-TABUP(KKK) ) 

JX = KKK 
1340 CONTIRtUE 

GO TO 1360 

1350 WRITE IN0T,162) W,W1 , ALPHA, BETA, AR ,DBELL, PHI, OPHl 
1360 LNCTR = LNCTR + 1 
1370 CONTINUE 

SAVE OATA TO PLOT 

KSAVE = KSAVE ♦ 1 
SAVED (KSAVE) = W 
SAVED(KSAVE) = OEELL 
SAVEP(KSAVF) = OPHI 
SAVEAIKSAVE) = AR 


14B0 CONTINUE 

CONTINUE FREQUENCY SWEEP UNTIL LIMITS ARE EXHAUSTED. 

IF (W1 .LT. OBLECFMAX) .AND. KSAVE .LT. KOSAVEI GO TO 420 

NORMAL TERMINATION LOGIC. 

1490 CONTINUE 
C 

KSAVE = KSAVE-1 
C 

RETURN 

C ERROR EXITS 
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c 

1210 CALL PAGEHD 

WRITE (NOT, 135) NRN 
GO TO 1490 
C 

1220 CALL PAGEHO 

WRITE (NOT, 137) NCN 
GO TO 1440 
C 

1230 CALL PAGEHD 

WRITE (NOT, 139) NPO 
GO TO r 90 

ERROR EXIT 

1240 CALL PAGEHD 

WRITE (NOT, 141) NCO 
135 FORMAT (54HDATA FOR 
1 15) 

137 FORMAT (54 HD AT A FOR 
1 15 ) 

139 FORMAT (54H0ATA FOR 
1 15) 

141 FORMAT (54H0ATA FOR 
1 15) 


FORMATS 

NRN IS INCORRECT IN 
NCN IS INCORRECT IN 
NRD IS INCORRECT IN 
NCD IS INCORRECT IN 


SUBROUTINE SFPEQ2, NRN 
SUBROUTINE SFREQ2, NCN 
SUBROUTINE SFRE02, NRD 
SUBROUTINE SFREQ2, NCD 


STOP 

END 
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IHDGtP SHAFT? 
tFORvIS SHAFT? 

COMPILER f XH=l) , <EQU1V=CMN) 

SUBROUTINE SHAFT? (TSHFT) 

IMPLICIT DOUBLE PRECISION (A-H,0-Z) 

DIMENSION TSHFT m 
C 

COMMON /MAXMUM/ 

* NBMAX tNHMAX «NSPMAX«NMWMAX»NMWBOO«NMDBOD»KMU*KYtKU 

COMMON /SPECIF/ 

* BETAHI6* 5)fBETAHD(6t 5)»AMO(2* 5) »RH(3«3«24) ,RS(3«3«20)» 

* DH(3f 28)«DS(3»20)tlMO(3« 5)«NM0W{5» 5} •IFTSMUdOlf 

* NR.^^HtNSPT♦NOFMOtNDELTA♦ITOPOH2, 5>»IRGFLXI 5I,IHDATA(7, 5»t 

* LOCUr 12 ) ,LENU ( 1 2 } «NU »NBETA *NLAM,NEO 

COMMON /VECTOR/ 

* YC250»tYDT{250) 

CCCCCCC THIS COMMON IS TRANSFER BETWEEN CONTRL AND SHAFT? ONLY 

COMMON /WHEEL / 

* CLMI4I 
C 

DATA IlST / 0 / 

C 

IF CHS? ,E0, 1) GO TO 10 
IlST = 1 
DO 5 I=1,NMWMAX 
5 TSHFTtI) = O.D 0 
C 

10 DO 15 1=1,4 
15 TSHFT(l) = CLMfl) 

C 

RETURN 

END 
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tHDG,P SIFT 

tFOP.lS SIFT 

COMPILER < XM=1 It (ECUIV=tMN) 

SUBROUTINE SIFT (A,N,TOLI 
IMPLICIT DOUBLE PRECISION CA-H,0-ZI 
DIMENSION All I 

SUBROUTINE SEARCHES ARRAY, A, FOR SMALL VALUES OF A AND SETS 
THFSE SMALL VALUES TO 0.0. 

SUBROUTINE ARGUMENT DESCRIPTIONS 

A = INPUT, OUTPUT VECTOR ARRAY TO BE SCANNED FOR SMALL VALUES. 

N = INPUT SIZE OF A. 

TOL = INPUT TOLERANCE. IF (All) .LT. TOL All) = 0.0 
DO 10 1=1, N 

IF (DABS(A(in .LT. TOL) All) = O.DO 
10 CONTINUE 
C 

RETURN 

END 
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[H06»P SKEWV3 
tF0R*IS SKEWV3 

COMPILER ( XM=l>t *EQUIV-CMN» 
SUBROUTINE SKEWV3C V,SKV*KVtKSKV» 
IMPLICIT DOUBLE PREC ISICNI A~H,0-Z) 
C 

DIMENSION V(KV,1 )tSKV(KSKV*lJ 
C 

SRV(2t3) = V(l,l) 

SKV(3,l) = V»2,l) 

SKV<1,2) = V(3.1) 

SKVC3f2) = -SKV(2t3) 

SKV(lt3) = -SKV<3,1) 

SKV(2fl) = -SKV(1,2> 

SKVIltD = O.D O 
SKVf2»2) = O.D 0 
SKV(3f3» = O.D 0 
C 

RETURN 

END 


-007938 

-007939 

-007940 

007941 

-007942 

007943 

007944 

007945 

00794c 

007947 

007948 

007949 

007950 

007951 

007952 

007953 

007954 

007955 

007956 

007957 



ooowcjuuuuuwuau 


CHDGtP SPLOT 
rPOPflS SPLOT 

COMPUFR ( XM = n, (FCUIV=CMN) 

SUePPUlIvr SPLOT (TlTLFtPMAXf FMIN.OFMIN.DEMAX) 


♦ ♦♦ 

*»♦ MSFC UNIVAC 1108 VFRSIPN ♦♦♦ 

♦ ♦♦ 

SUBROUTINE FORMS BODE PLOTS 

SUBROUTINE ARGUMENT DESCRIPTIONS 

TITLE = INPUT ALPHA NUMERIC TITLE 

FMAX = INPUT UPPER LIMIT - FREQUENCY SWEEP 

FMIN = INPUT LOWER LIMIT - FREQUENCY SWEEP 

DEMIN = INPUT MINIMUM DB TO PLOT 

DBMAX = INPUT MAXIMUM DB TO PLOT 

COMMON /LSTART/ IRUNNO, lOATEt NPAGE 
COMMON /PS TUFF/ 

♦ SAVE0(500)» SAVEP(500»* SAVED (500), SAVEAI500), KSAVE 

COMMON /ADDPLT/ OB (500 ) ,PH( 500) ,X (5001 
C 

DIMENS ION TITLE C 1 ) ,TX ( 12 ) ,TY(12 ) 

C 

EQUIVALENCE ( TPUNNO, PUNNO ) 

C 

TX( 1) = 6H 
DO 5 1 = 1 ,10 
5 TX(I+1) = TITLE(I) 

TX(1?) = 6H 
C 

CALL SMXYV(1,0) 

C 

KNT = 0 

DO 10 1=1, KSAVE 
FR = SAVEOn ) 

1F(FR .LT. FMIN .OR. FR .GT. FMAX) 60 TO 10 
KNT = KNT + 1 
DB(KNT) = SAVED(I) 

IF(OB(KNT) .GT. DBMAX) DB(KNT) = DBMAX 
IF(DB(KNT) .LT. DBHIN) DB(KNT) = DBMIN 
PH(KNT) = SAVEP(l) 

IF(PH(KNT) .GT. 180.0) PH(KNT) = PH(KNT) - 360.0 
X(KNT) = FR 
10 CONTINUE 
C 

TY( 1) = 6HB0DE P 

TY( 2) = 6HL0T 

TY( 3) = 6H 


-007958 

-007959 

-007960 

-007961 

-007962 

-007963 

-007964 

-007965 

-007966 

-007967 

-007968 

-007969 

-007970 

-007971 

-007972 

-007973 

-007974 

-007975 

-007976 

-007977 

-007978 

-007979 

-007980 

-007981 

-007982 

-007983 

-007984 

-007985 

-007986 

-007987 

-007988 

-007989 

-007990 

-007991 

-007992 

-007993 

-007994 

-007995 

-007996 

-007997 

-007998 

-007999 

-008000 

-008001 

-008002 

-008003 

-008004 

-008005 

-008006 

-008007 
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TYI 4) = 6HGAIN I 
TY< 5> = 6HN OB V 
rye 6> = 6HS FREQ 
TY< 7) = 6H IN RA 
7Y( 8» = 6HD/SEC 
TY( 9 ) = 6H 
TYCIO) = 6H 
TY(ll) = 6H 
TY(12) = RNNNO 

CALL P LOTS S (DBMAX tOBM IN , YTOP t YBOT ) 

CALL QUKLOGI-l,FHlN,FHAX,YBnT*YTOP.35,TX,TY,-KNT,X»DB) 
C 

TYC 4» = 6HPHASE 
TYC 51 = 6HIN DEG 
TY( 61 = 6H VS FP. 

TY( 71 = 6HE0 IN 
TY( 8) = 6HRA0/SE 
TY( 9) = 6HC 

CA LL P LOTS S( 200 . ,-200. , YTOP , YBOT) 

CALL QlEKLOG{-l,FMIN,FMAX,YPOT,YTOP,35,TX,tY,-KNT,X,PH) 
C 

CALL SMXYVI0,0) 

C 

RETURN 

END 


-008008 

-008009 

-008010 

-008011 

-008012 

-008013 

-008014 

-008015 

-008016 

-008017 

-008018 

-008019 

-008020 

-008021 

-008022 

-008023 

-008024 

-008025 

-008026 

-008027 

-006028 

-008029 

-006030 

-008031 

-006032 




1 


.1 
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[H0G»P SUEOIA 
[FOR, IS SUBDIA 

COMPILER ( XM=1 >, CEOUIV=CMN) 

SUBROUTINE SUBOIA (AtM»KRtB) 

IMPLICIT DOUBLE PREC ISICN C A-H »0-2 ) 

DIMENSION A<KR,1),P(1> 

C SUBROUTINE TO PUT MATRIX IN UPPER HESSENBERG FORM. 

IF (M -- 2) 260» 260» 100 
100 DO 250 LC = 3*M 
N =■ M - LC + 3 
N1 =: N ^ I 
N2 = N - 2 
NI = Nl 

DIV = DABSfACNfN~in 
DO 120 J - 1,N2 

IFCOARSC AiNrJ) DIV) 120t 120t 110 
110 NI = J 

DIV = DABS (A(Nf J)) 

120 CONTINUE 

IF(DIV) 130f 250» 130 
130 IF(NI - Nl) 140f 170f 140 
140 DO 150 J = 1»N 
DIV A( JtNI ) 

A( J,NI ) A( J,N1 ) 

150 AC JfNl ) DIV 

DC 160 J ^ 1»M 
DIV = ACNIfJ) 

ACNI,J) - A(N1,J) 

160 A(NltJ) = DIV 

170 DO 180 K It Nl 

180 6CK) = AfVtK »/A(NtN-l) 

DO 240 J = ItM 
SUM =: O.DO 

IF (J - Nl ) 190t 220, 220 
190 IFCBCJn 200, 220, 200 
200 A(N»J) = O.DO 
DO no K = 1,N1 

A(K,J) A(K,J) - A(K,N1)«B(J) 

210 SUM SUM HH A(K,J)*B(K) 

GO TO 240 

220 DO 230 K = 1,N1 

230 SUM = SUM + A(K,J)*BIK) 

240 ACNltJ) SUM 
250 CONTINUE 
260 RETURN 
END 


-008033 

-008034 

-008035 

006036 

-008037 

008038 

006039 

008040 

008041 

008042 

008043 

006044 

008045 

008046 

00804? 

006048 

008049 

008050 

008051 

008052 

008053 

008054 

C08055 

008056 

008057 

008058 

008059 

008060 

008061 

008062 

008063 

008064 

008065 

008066 

008067 

008068 

008069 

008070 

008071 

008072 

008073 

008074 

006075 

008076 

008077 

008078 


! 
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CHDG.P START 
I FOR, IS START 

COMPILER IXM=1I, (ECUIV=CMN) 

SUBROUTINE START 
C 
C 

C *** MSEC UMIVAC 1108 VERSION ♦♦♦ 

C 

COMMON /LSTART/ IRUNNO, IDATE, NPAGE 
COMMON /LSTRTl/ UNAMEI3J, TITLEK12I, TITLE2(12) 
C 

DATA NIT, NOT,ISTOP / 5, 6, 6HST0P / 

C 

1001 FORMAT fA6, AX, 3A6) 

1002 F0RMaT(12A6) 

2003 F0RMATI36H1END OF INPUT DATA HAS BEEN REACHED. I 
C 

READ (NIT, 1001) IRUNNO, UNAME 
IF (IRUNNO .NE.ISTOP) GO TO 10 
WRITE I NOT, 2003) 

STOP 

C 

10 RE AO (NIT, 1002) TITLE 1 
READ (NIT, 1002) TITLE2 
NPAGE =0 
C 

RETURN 

END 


-00B079 
-008080 
-008081 
-008082 
-008083 
-008084 
-00B085 
-008086 
-00 8 067 
-008088 
-008089 
-006090 
-008091 
-00B092 
-006093 
-008094 
-008095 
-006096 
-008097 
-008098 

-one 099 
-006 100 
-008101 
-008102 
-006103 
-008104 
-008105 
-008106 


n n o o o n o 


CHDG.P STORE 
r FOR, IS STORE 

COMPILER (XM=l»f (EQU1V=CMN» 

SUBROUTINE STORE CNTAPE ,A»6 , Z*NA*NCP f KR A .KRB tK«Z ) 

IMPLICIT DOUBLE PREC ISIPNf A-H,0-Z) 

MATRIX PRODUCT Z = A*B WITH A = DIAGONAL AND STORED AS VECTOR 
PRODUCT WRITTEN BY ROWS ON NTAPE 

WHERE A = INPUT (NAtNA) 

B = INPUT (NA»NCB) 

Z = OUTPUT INAfNCB) 

DIMENSION A(KRAtl)*B(KRBtntZ(KRZtn 
C 

DO 10 I=1»NA 
S = Afl,l> 

DO 10 J=ltNCB 
10 Z(I,J) = 

C 

WRITECNTAPEI (( Z f I « J ) • J-1 «NCB 1 »I-1 ,NA ) 

C 

RETURN 

END 


-008107 
-008108 
-008109 
008110 
-008111 
008112 
008113 
008 llA 
008115 
008116 
008117 
008118 
008119 
008120 
008121 
008122 
008 1 23 
008124 
008125 
008126 
008127 
008128 
008129 


o n o o n o o r> o o ooooooononoooooonnoooo 
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tHDGfP TFPLY 
tFOR.lS TFPLY 

COMPILFR (XH=1),(F0UIV=CMNI 
SUBROUTINE TFPLY ( A, B .U,X ,NS ,L ) 

IMPLICIT DOUBLE PRECISION CA-HtO-Z) 

C 

DIMENSION Ad), Bd) 

SUBROUTINE CONVERTS TRANSFER FUNCTION POLYNOMINAL 

EXPRESSIONS TO FIRST ORDER CANONICAL STATE 
SPACE FORM AND RETURNS THE TRANSFORMED OUTPUT 
VARIABLE, X. 

SUBROUTINE ARGUMENT DESCRIPTIONS 

A = INPUT VECTOR OF DENOMINATOR POLYNOMINAL 

COEFFICIENTS — ASCENDING ORDER. 

B = INPUT VECTOR OF NUMERATOR POLYNOMINAL 

COEFFICIENTS — ASCENDING ORDER- 
U = INPUT STATE VARIABLE TO BE OPERATED ON BY THE 

POLYNOMINAL TRANSFER FUNCTION. 

X = OUTPUT VARIABLE RESULTING FROM THE TRANSFER 

FUNCTION OPERATING ON U. 

NS = INPUT SIZE OF A AND B. 

L = INPUT LOCATION (IN STATE VECTOR) OF THE 

LEADING ELEMENT OF THE NS-1 STATE VARIABLES 
ESTABLISHED FROM THE POLYNCMINALS. 


COMMON /VECTOR/ 

E Y (250), YD (250) 

DATA NIT/ 6 / 

NORMALIZE A AND B COEFFICIENTS TO COEFFICIENT OF 
HIGHEST DERIVATIVE IN DENOMINATOR, A(NS). 

AN = A(NS) 

IF (AN .EO. 0.00) GO TO 999 

DO 10 1=1, NS 
Ad) = A(I) / AN 
10 BCD = B(I) / AN 

BN = B(NS) 

FORM STATE VECTOR TIME DERIVATIVES AND PUT INTO YDOT 
BEGINNING WITH LOCATION L IN YDOT. 

00 20 1=2, NS 


-008 1 30 
-008131 
-008132 
008133 
-008 1 34 
008135 
008136 
008137 
008138 
008139 
008140 
008141 
008142 
008143 
008144 
008145 
008146 
008147 
008148 
008149 
008 1 50 
006151 
008152 
008 1 53 
008154 
008155 
008156 
008157 
008158 
008159 
A3 008 160 
008161 
008 162 
008163 
008164 
008165 
008166 
008167 
008168 
008169 
OOe 170 
008171 
008172 
008173 
008174 
008175 
008176 
008177 
008178 
008179 


1 
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J = NS-I + 1 008180 

K = L+I-2 008181 

IF (I .EO. NS) GO TO 25 008182 

C 008183 

20 YD<K) = -A(J)*Y(L) ♦ Y(K+1) ♦ CBIJ)-A( J )*BN)*U 008184 

25 YD(K) = -A(J)*Y(L) ♦ IBf J)-AIJ)*BN»*U 008185 

C 008 1 86 

X = Y(L) + EN*U 008187 

G 008189 

RETURN 008189 

C 008190 

999 CALL PAGEHD 008191 

WRITE JNIT.IOOI) 008192 

1001 FORMAT (///,10X,33HC0EFF1C1ENT OF HIGHEST , 008193 

* /,10X,32H0ERIVAT1VE OF DENOMINATOR CANNOT , 008194 

* /,10X,17HBE EQUAL TO ZERO. » 008195 

* //,10X,16HPR0GRAM STOPPED.) 008196 

C 008197 

STOP 008 198 

END 008199 



ooooonnoooonooooooooonnooooon 
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(H0G«P TFTYPE 
(FOR, IS TFTYPE 

COMPILER (XM=1),CE0UIV=CHN) 

SUBROUTINE TFTYPE (A ,Z ,B,NA,NZ ,ITYPE , JCOL,NBKP,KBKP,KA,KZ ) 
IMPLICIT DOUBLE PREC ISION ( A-H,0-Z ) 

C 

COMMON /LOSIZE/ 

2 NX, NY, NDLTA, NXSS, NB, NJO, NY2, ND2 

C 

DIMENSION A(KA,1), Z(KZ,1), BID, KBKPd) 

SUBROUTINE ARGUMENT DESCRIPTIONS 


A 

Z 

B 

NA 

NZ 

I TYPE 


INPUT 

OUTPUT 

OUTPUT 

INPUT 

OUTPUT 

INPUT 


PARTIAL DERIVATIVE MATRIX 
REDUCED PARTIAL DERIVATIVE MATRIX. (NZ,NZ) 
VECTOR OF COEFF. FOR DESIRED TF INPUT. (NZ,1» 
SIZE OF A. 

SIZE OF Z 


=1 FORWARD PATH TF 

2 FEEDBACK TF 

3 OPEN LOOP TF 
A OPEN LOOP TF 

5 CLOSED LOOP TF 

6 CLOSED LOOP TF 

7 PARTIAL OPEN LOOP 


XSS(I)/RT(J) 
BCI»/RS( J) 
B(I)/RT( J) 
XSSm/RS( J) 
XSS( I)/RT(J1 
XSSf n/RS(Jl 
BII)/RT(J) 


NOTE — A MINUS SIGN ON ITYPE INDICATES 
NEGATIVE FEEDBACK FOR NUMERATOR 
AUGMENTATION SELECTION OF PROPER B. 


JCOL = INPUT COL LOCATION IN A OF DESIRED INPUTCJI. LOCAL 

NBKP = INPUT NO. OF B"S TO RETAIN 1TYPE=7 

KBKP = INPUT ID VECTOR NOTING WHICH B*S TO KEEP (LOCAL) 

KA = INPUT ROW DIMENSION OF A IN CALLING PROGRAM 

KZ = INPUT ROW DIMENSION OF Z IN CALLING PROGRAM 

ESTABLISH LEADING ELE LOCATORS FOR EACH PARTITION OF A 
ASSUMED ORDER IS Y,XSS,DELTA,B 


C 


LY = 1 

LX = LY + NY2 

LO = LX + NXSS 

LB = LD + N02 

XSN = ISIGNd, ITYPE) 

ITYPE = TABS (ITYPE) 

NERROR = 1 

IF (ITYPE .LT. 1 .OR. ITYPE .GT. 7) GO TO 99«» 
NERROR = 2 

IF (JCOL .LT. 0 .OR. JCOL .GT. NA) GO TO 999 


-008200 
-008201 
-008202 
008203 
-008204 
008205 
008 206 
008207 
008208 
008209 
008210 
008211 
008212 
008213 
008214 
008215 
006216 
008217 
006218 
008219 
008220 
008221 
008222 
008223 
008224 
008225 
008226 
008227 
008228 
008229 
006230 
008231 
006232 
008233 
008234 
008235 
008236 
008237 
008238 
008239 
008240 
008241 
008242 
008243 
008244 
008245 
006246 
008247 
008248 
008249 


nonnoonn n nonooooo o noonoono 
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GO TO (l,2,3.4,5,6tTI,ITYPE 

008250 

008251 

1 

CONTIWE 

008252 

006253 


ITYPE = 1 

008254 


FORM Z = A11,A12 

008255 

008256 


A21.A22 

008257 


B = A14C JC0LI*XSM 

008258 

008259 


A24(JC0L)*XSN 

008260 


HZ ~ NY2 ♦ NXSS 

008261 

008262 


KCOL = LE-l+JCOL 

008263 


DO 10 1:^1, NZ 

008264 


B(l) = Afl.KCOLl ♦ XSN 

008265 


DO 10 J-1,NZ 

008266 

10 

ZCI*J1 = A(I,J) 

008267 


RETURN 

008268 

2 

CONTINUE 

008269 

008270 


ITYPE = 2 

008271 


FORM Z = A33,A34 

008272 

008273 


A43,A44 

008274 



008275 


B = A32tJC0U 

008276 


A42( JCOL) 

008277 


NZ = ND2 ♦ NB 

008278 

008279 


KCOL = LX-l+JCOL 

008280 


CALL ZFPO fZtNZ»NZ«KZl 

008281 


00 20 1=1, NZ 

008282 


IRA = I + NY2 + NXSS 

008283 


BID = AllPAtKCOLl 

008284 


00 20 J=1,NZ 

008285 


JCA = J + NY2 + NXSS 

008286 


2(1, J) = A(1RA,JCA) 

008287 

20 

CONTINUE 

008288 


RETURN 

008289 

3 

CONTINUE 

008290 

008291 


ITYPE = 3 

FORM Z = A11,A12, 0, 0 

008292 

008293 

008294 


A21,A22, 0, 0 

008295 


0,A32,A33,A34 

008296 


0,A42,A43,A44 

008297 


B = A14(JC0L)»XSN 

008298 

008299 


n n n r> n n n n n n n o o o o o 
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C 

c 


A24(JC0LI*XSN 

O 

0 

NZ = MY2 ♦ NXSS + ND2 + NB 
KCOL = LB-l+JCPL 
CALL ZERO (Z»NZ*NZ»KZI 
M = NY2 NXSS 
DO 25 1=1, H 
BCD = AfI,KCOU ♦ XSN 
DO 25 J=1,M 
25 ZCI,J) = A(I,J) 

DO 30 1=LD,NZ 
BCD = O.DO 
DO 30 J=LX,NZ 
Z(I,J) = A(I,J) 

30 CONTINUE 
RETURN 

4 CONTINUE 

1 TYPE = 4 

FORM Z = A11,A12, 0.A14 

A21,A22t 0,A24 

0, 0,A33,A34 

0, 0,A43»A44 

B = 0 

0 

A32CJC0LI 

A42(JC0L) 

N2 = NY2 + NXSS + ND2 + NB 

KCOL = LX-l+JCOL 

CALL ZERO fZ,NZ,NZ,KZ) 

M = NY2 ♦ NXSS 
DO 35 1=1, M 
BCD = O.DO 
DO 35 J=1,NZ 

IF tJ .GE. LD .AND. J .LT. LB) GO 
Z(I,J) = A(I,J) 

35 CONTINUE 

DO 40 I=LO,NZ 
BCD = ACIfKCOL) 

DO 40 J=LD,NZ 
ZCI,J) = A(I,J) 

40 CONTINUE 
RETURN 

5 CONTINUE 

ITYPE = 5 


008300 
008 30 J 
008302 
006303 
008304 
008305 
008306 
008307 
008308 
008309 
008310 
008311 
00B3I2 
008313 
006314 
008315 
008316 
008317 
008318 
008319 
008320 
008321 
008322 
008323 
008324 
008325 
008 326 
008327 
008328 
008329 
008330 
008331 
008332 
008333 
008334 
008335 
008336 
008337 

35 008338 

008339 

008340 

008341 

008342 

008343 

008344 

008345 

008346 

008347 

008348 

008349 


nnonnonnnoo n r> o n n o n n n o 
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FORM Z = A11,A12, 0,A14 

A71»A22« 0.A24 

0tA32,A33,A3A 
0*AA2f AA3,A4A 

B = A1A|JC0L>*XSN 
A24( JCOU*XSN 
O 
O 

NZ = NY2 ♦ NXSS ♦ N02 ♦ NB 
KCOL = LB-I+JCDL 
M = NY2 *■ NXSS 
CALL ZERO (Z,NZ»NZ«KZ) 

DO 45 I = 1,M 

B( I) = A(I fKCCL) ♦ XSN 

DO 45 J=1,NZ 

IF (J -GE. LD .AND. J .LT. LPI GO 
Z(T«J) = A(I,J1 
45 CONTINUE 

DO 50 I=LD ,NZ 
B(I) = O.DO 
DO 50 J=LX,NZ 
ZCl.J) = AIT,J) 

50 CONTINUE 
RETURN 

6 CONTINUE 

ITYPE = 6 

FORM Z = A11»A12» 0#A14 

A21tA22» 0.A24 

O tA32tA33,A34 
0*A42,A43tA44 

B = 0 

0 

A32 

A42 

NZ = NY2 + NXSS ♦ N02 ♦ NB 

KCOL - LX-l+JCOL 

CALL ZERO rZ,NZ,NZ«KZ) 

M = NY2 + NXSS 
DO 55 1=1, M 
B(I) = O.DO 
DO 55 J=1,NZ 

IF fJ.GE. LD .AND. J .LT.LBI GO TO 
Z(I,J) = A(I,J) 

55 CONTINUE 

DO 60 I=LD,NZ 
B(I) = Ad ,KCOL) 
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008350 

008351 

008352 

008353 

008354 

008355 

008356 

008357 

008358 

008359 

008360 

008361 

008362 

008363 

008364 

008365 

TO 45 008 366 

008367 

008368 

008369 

008370 

008371 

008372 

008373 

008374 

008375 

008376 

008377 

008378 

008379 

008380 

008381 

008382 

008383 

008384 

006385 

008386 

008387 

008388 

008389 

008390 

008391 

008392 

008393 

008394 

55 008395 

008396 

008397 

008398 

008399 
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DO 60 J==LX,NZ 
ZCI.JJ = A«I,JI 
60 CONTINUF 
RETURN 


7 CONTINUE 

— ITYPE = 7 

FORM Z = AlltA12, 0 ,U14» 
A2ItAZ2» 0 «(A24) 

0 tA32»A33«A34 
0 ,A42.A43tA44 

B = A14C JC0L»*XSN 
A24(JC0L)*XSN 
0 
0 

NZ = NY2 + NXSS + ND2 ♦ MB 

KCOL = LB-I+JCOL 

CALL ZERO (ZtNZtNZfKZ) 

M = NY2 ♦ NXSS 
DO 65 I=ltM 

B(I) = AdtKCOL) ♦ XSN 
00 62 J*1,M 

62 Z(ItJ) := A(ItJ) 

DO 63 J=1,NBKP 
LCOL = LB-1+KBKP(J) 

63 ZdvLCOL) = A(I*LCOL) 

65 CONTINUE 

DO 70 I=LD,NZ 
BCD * O.DO 
DO 70 J=LX,NZ 
ZfItJ) AI1,J) 

70 CONTINUE 
RETURN 

999 CONTINUE 

WRITE (6,2001) NERROR 
2001 FORMAT ( 1H1,5X ,48HPR0GRAM STOPPED 
* , 13) 

STOP 

END 


008400 

006401 

008402 

008403 

008404 

008405 

008406 

0OB407 

008408 

008409 

008410 

008411 

008412 

008413 

008414 

008415 

006416 

008417 

008418 

008419 

008420 

008421 

008422 

008423 

008424 

008425 

008426 

008427 

008428 

008429 

008430 

008431 

008432 

008433 

006434 

008435 

008436 

008437 

008438 

IN SUBROUTINE TFTYPE. NERROR = 000439 

008440 

006441 

008442 

008443 


t 
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tHDGf 

p 

TORQUE 

-008A44 

TFOR, 

IS 

TORQUE 

>^008445 

ij 

COMPILFR ( XM=1 » , (EQUIV=CMN» 

-008446 


SUBROUTINE TORQUE «G J 

006447 

i; 

IMPLICIT DOUBLE PREC ISION C A-H ,0-Z 1 

-C08448 

i; 

DIMENSION GUI 

008449 

c 



008450 

l; 


COMMON /BHBSRD/ 

008451 


♦ 

PH(6,1?, 9) ,PS(6,12,10»,R0L(3,3, 51,D0L(3* 51 

206452 

ij 


COMMON /GGSAVE/ 

008453 



GGS( 6,9, 5) 

308454 

5 


COMMON /INTGRL/ 

008455 

? 


AMC 7fl, 5),AC0FC9, 6, 5»,BC0F<6, 6, 5), 

508456 



COFIK 6, 6, 5),COF22f 6, 6, 5»*C0F33( 6, 6, 5),AKJ 6, 6, 

5), 608457 

i 


C0F12( 6, 6, 5),C0F13( 6, 6, 5»,COF23f 6* 6* 51, ADC 6, 6, 

5>t 708458 

! 

♦ 

CGFXY( 6, 6, 5»,C0FXZC 6, 6, 5>,C0FYZI 6, 6* 51 

808459 

r 


COMMON /MAXMUM/ 

008460 

1 

♦ 

NBM AX ,NHM AX , NSPM AX ,NMWMAX ,NM WBCO , NMOE OD ,K MU, KY ,KU 

008461 



COMMON /MOMENG/ 

006462 


* 

P( 65 1,PMOM(30) ,HT0TI3),TCTL(31,ENGKEC 5»,ENGPE( 51, 

1 108463 


apt 

TCTKE, TOTPE, TOTENG, AHTOT,ATOTL 

008464 

f! 


COMMON /NUMBRS/ 

008465 


* 

2R0,0NE,TW0,TRES 

008466 

l! 


COMMON /SPECIF/ 

008467 

j 

3»: 

BETAH(6, 5),BETAH0C6, 5),AM0(2, 5 1 ,RHC3,3 ,24) ,RS 1 3,3 ,20 1 , 

1608468 



DH(3,2el,OS(3,20),IMOf3, 5),NM0W(5, 5) ,IFTSMWn0) , 

1708469 

i • 

♦ 

NB,NH,NSPT,NOFHO,NDELTA,ITOPOU2, 5),IRGFLXC 5I,IHDATA<7, 

51 f 1808470 

1 

♦ 

L0CU(12) ,LENU(12),NU,NBETA ,NLAM,NE0 

1908471 

i’ 

{: 


COMMON /VECTOR/ 

008472 

i- 

it 

YI250 ),Y0T(250) 

2008473 

c 



008474 

t; 

DIMENSION CW( 6t3)#RW(3t 6ltVll 6) ,WSK{3t3l tTSHFTC 5)t 

8708475 


it 

TFXI6 ,10),ISPNn0),V(6|,V2f 6) 

8808476 

C 



008477 

ccc 

SUBROUTINE CONTRL ESTAELISHES THE D/DTfDELTAS» USER SUPPLIED 

— 008478 


CALL CONTRL 

008479 

C 



008480 

1 ccc 

SUBROUTINE EXTOR ESTABLISHES ALL EXTERNAL TORQUES t INCLUDING RCS 008481 

1 cccc 

CONTROL TOROUESt ETC.* USER SUPPLIED — 

008482 

i 

CALL EXTOR CTEX , ISPN ,NTEX > 

008483 


IF 

INTEX .EQ. 0) GO TO 5 

008484 

1 c 



006465 

1 

a 

DO 

65 L=1,NTEX 

008486 

1 

fi 

NSP 

= ISPNCL) 

008487 


NBOO = IFTSMM(NSP) 

008488 


LON 

= LOCU(NBOD) - 1 

008489 

1 

1 

LEN 

= IRGFLX(NBOD) + 6 

008490 

1 

DO 

66 1=1,6 

008491 

is 

i 

TQ 

= TEX(I,L) 

008492 

\ 

IF 

(TO .EO. ZROI GO TO 66 

008493 


I 
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00 67 J=1,LEN 
JL = J + LON 

67 GCJU = GCJLI + TO*BS(I*JtNSPl 
66 CONTINUE 
65 CONTINUE 
C 

CCC SUBROUTINE SHAFTT ESTABLISHES SHAFT TORQUE FOR EACH 

CCCC HOHENTUM WHEEL C ZEROS IT OUT IF CONSTANT SPEED) USER SUPPLIED — 

5 CALL SHAFTT CTSHFT) 

C 

CCCC SETUP HINGE SPRING AND DASHPOT RESTORING TORQUES 
CCCC ALSO ACCOUNT FOR POTENTIAL ENERGY DUE TO HINGE SPRINGS 
CALL KHINGE (G) 

C 

C 

KM = NMDBOD 
DO 50 N=1,NP 
LOU = LOCUfN) 

LO = LOCUCN+NB) 

LE = LFNU(N+NB) 

LEU = LE •« 6 

IF (LE .EQ. 0) LEU = 3 

LOUl = LOU t 1 

L0U2 = LOU + 2 

LOUS = LOU + 3 

L0U4 = LOU + 4 

L0U5 = LOU + 5 

CALL SKEWV3 (Y(L0U),WSK,1 ,3) 

CALL MULTAD (WSK »P (LOU) »G (LOU) «3 t3 *1*3 t 1 t 1 ) 

CALL MULTAD (WSK,P (LDU3 ) ,G( L0U3 ),3,3 ,1 t 3t 1 t 1 ) 

CALL SKEWV3 ( Y (L0U3) ,WSK» 1 ,3) 

CALL MULTAD (WSK »P (L0U3) t G( LOU) »3t 3* 1 t3 *I ♦ 1 ) 

IF (LE ,E0. 0) GO TO 100 
CALL GMISC (N,LE,L0,V2) 

CALL MULT3 ( AK ( 1,1,N) ,V2 ,Vlt LE,LE tl tKM *1 f 1 ) 

CALL MULTAD ( AD( 1, 1*N) ,YDT(LO ) ,Vl,LEtLE ,1,KM,1 ,1 ) 

00 10 J=1,LE 

1 = L0U5 + J 

10 G(I) = G(1 ) - VI (J) 

C 

DO 15 J=1,LE 

CW(J.l) = -TWO*Y(LGU )*(BC0F(1,J,N) + GGS(J,1,N)) 

♦ ♦ Y(L0U1)*(BC0F(4,J,N) + GGS(J,4*N) GGS(J,7,N)) 

♦ + Y(L0U?)»(BC0F(5»JfN) -^GGSIJtStN) +GGS(J*8,N)) 

♦ -Y(L0U3)*AC0F(lt JfN) — Y(L0U4)*AC0F ( 2 * J»N ) - Y( LOUS )*ACOF (3 1 J»N) 
CW(J,2) = -TH0*Y(L0Ul)*(BC0F(2,JtN) + GGS(J»2,N)) 

♦ + Y(L0U2)*(BC0F(6,J,N) +GGS(J,6»N) +GGS(Jf9,N)) 

♦ + Y(L0U )*(BC0F(4,J*N) + GGS(J»4»N) + GGS(J»7tN)) 

♦ -Y(L0U3)*AC0F(4,J,N) - Y(L0U4)*AC0F(5,J,N) - Y( L0U5)*AC0F(6t J#N) 
CW(J,3) = -TW0*Y(L0U2)*(BC0F(3.J,N) + GGS(J»3«N)) 


008494 
008495 
008496 
008497 
008498 
008499 
008 500 
008501 
008 502 
008 503 
008504 
008505 
008506 
008507 
008508 
008509 
008510 
008511 
008512 
008513 
008514 
008515 
008516 
008517 
008518 
008519 
008520 
008521 
008522 
008523 
008524 
008525 
008526 
008527 
008528 
008529 
008530 
008531 
008532 
008533 
0C»8534 
008535 
008536 
008537 
008538 
008539 
008540 
008541 
008542 
008543 
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♦ + Y(LOU )*(BC0F(5#J#N» ♦ GGSfJ«5,N) + GG5(J«8,!4)) 

♦ + Y(L0Ul)*(BC0Ff6,J,N) + GG«;(Jt6»N) +GGS(J»‘?,Nn 

♦ -Y(LnU31=»AC0F|7f J,N) - Yl LOU<»)*ACOF C 8 , J,N ) - Y( LOUS I ♦ACOF *9, J,N > 
15 CONTINUE 

CALL MULTAO ( YDT (LO» tCW ,Gf LOU ) *1, LF ,3, 1 ,KM t 1 ) 

CALL MULT3 « COFXY ( 1 , 1 ,N) t YDT ILO) ,CW( 1 , 1 ) ,LF, L F, 1 . KM, 1 ,KM » 

CALL HULT3 (COFXZ 1 1 , 1 ,N) ,YDT CLO» ,CWO , ?) ,LE ,LF ,1 ,KM, 1 ,KM ) 

CALL MULT3 (COFYZ I 1 ,1 ,N) ,YDT ( LO) ,CW ( 1 , 3) ,LE,LE,1 ,KM,1,KMI 
CALL MULT? (YDTtLOl ,CW,V,1,LE,3,1 ,KM,1 I 
GaOU ) = G(LOU ) - VC 3) 

GCLOUl) = G(LOUl) - VC2> 

6(L0U2) = GILOU2I - VI 11 
DO 18 vl=l,LF 

CW(J,1) = -YCLCU »*ACOF(l,J,N) - Y| LOUl )*ACOF C A , J ,N I 

♦ -YCL0U2)*AC0FI7,J,N) 

CW(J,2) = -YCLCU |vACOFI 2;J,N) - YCLOUn*ACOFC5,J,N» 

♦ -YCLC>U2)*ACOFC8,J,N) 

CWCJ,3) = -YCLOU )*ACOF{3,J,N) - YCLOUl )*ACOF C6, J,N) 

♦ -YCLOU2)*ACOFC9, J,N) 

18 CONTINUE 

CALL MULTAD C YDTC LO) ,CW ,GIL0U3 ) ,1 ,LE ,3 , 1,KM ,1 ) 

C 

DO 20 J=1,LE 
I = LOUS ♦ J 

GCI) = GCI) + CYCLOU )*#2 )♦CBCOFC 1,J,N ) + GGSCJ,1,N)1 

♦ + CYCLOUl)**2)*IBCOFI2,J,N) ♦ GGSCJ,2,N)1 

♦ ♦ CYCL0U2)**2)»CBC0FC3,J,N) + GGECJ,3,N)) 

♦ - YCLOU )*YCL0U1)*CBC0F(A,J,N) + GGSCJ,A,N) + GGSCJ,7,N)) 

♦ -YCLOU )*YCLOU2)»CBCOFC5,J,N) +GGSCJ,5,N) +GGSCJ*8,N)) 

♦ - Yf LOUl )*YCL0U2)*CPC0Ff6,J,N> + GGSfJ,6,N) + GGSCJ,9,N)> 

♦ + YCLOU )*CYCL0U3)*AC0FC1, J,Nf) ■* Y C L0U4) *ACOF C 2 , J,N) 

♦ + YCLOLf5)*ACOFC3,J,N)1 

♦ + YCL0U1)#CYCLCU3I*AC0F(4,J,N) + Y C L0U4) ♦ACOF C 5 , J,N) 

♦ + YCL0U5)*ACnF|6,J,N) ) 

♦ + YCL0U2)*CYCL0U3)*AC0FC7,J,N) ■» YCLCU4)*AC0FC 6,J,N) 

♦ + YCL0U5)*AC0FC9,J,N) 1 

20 CONTINUE 

C 

CALL MULT3 CCOFXY C 1 ,1 ,N) , YDT CLO) ,CWC I , 1 ) ,LE ,LE ,1 ,KM, 1 ,KM I 
CALL MULT3 CCOFXZ C 1 ,1 ,N) .YOTCLO) ,CWC 1 , 2) ,LE,LE,1 ,KM, 1 ,KM 1 
CALL MULT3 CCOFYZ C 1 ,1 ,N) ,YOTI LO) ,CW C I , 3) ,LE ,LE ,I ,KM, 1 ,KH ) 

CALL MULT3 C YDTC LO) ,COFXYC 1, 1,N) , RW C 1 , 1 ) , 1 ,LE ,LE ,1 ,KM ,3 ) 

CALL MULT3 C YDTC LO) ,COFXZC 1, 1 ,N) ,RW C 2 , 1 ) , 1 , LE.LE , 1,KM,3 ) 

CALL MULT3 C YDTCLO) ,COFYZ( 1 , 1 ,N) ,RV#C 3 , 1 ) , 1 , LE ,LE ,1 ,KM,3 ) 

DC 30 J=1,LE 
I = LOUS + J 

GCI) = GCI) + YCLOU )*(CWCJ,3) -RWC3,J)) 

♦ + YCL0U1)*|CWIJ,2) - RWC2,J)) 

♦ ♦ YCLQU2)*CCW(J,1) - RWClyJ)) 

30 CONTINUE 


008544 

00B54S 
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008548 
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008 550 
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008552 
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008554 

008555 
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008557 

008558 

006559 

008560 

008561 

008562 

008563 

008564 

008565 

0D8566 

008567 

008568 

008569 

008570 

008571 

008572 

008573 

008574 

008575 

008576 

008577 

008578 

008579 

008580 

008581 

008582 

008583 

008584 

008585 

008586 
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008588 
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008590 
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008592 
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c 


008594 

100 

NMON = NM0WC1*N) 

008595 


IF (NMON .FO. 0) GO TO 50 

008596 


IC = 0 

008597 


DO 35 1=1, NMON 

008596 


IP2 =1+2 

006599 


NW = NM0WflP2,N) 

008600 


IF flMOOiNW) .EO. 01 GO TO 37 

0C8601 


IC = 1C + 1 

008602 


LMO = LOUS + LF ♦ IC 

008603 


TDTJ = Y(LML’)*AM0(2,NW» 

008604 


GO TO 38 

008605 

37 

TDTJ = AM0(1,NW)*AM0(2,NW| 

008606 

38 

NPTS = 1M0I1,NW> 

008607 


NAX = 1H0C2,NW» 

008608 


CALL MULT3 (BSC 1, 1,NPTS 1 , YCLOUl ,Vf « ) ,3 ,LFU, 1 ,6, 1 , 1 » 

008609 


GO TO (41, 42 ,431, NAX 

008610 

41 

V(l) = ZRO 

008611 


V(2) = -V(6»*TDTJ 

008612 


V(3» = V(5)*TDTJ 

008613 


GO TO AO 

006614 

42 

V(l> = V(6»*T0TJ 

008615 


V(2» = ZRO 

008616 


V(3) = -V(4)*T0TJ 

008617 


GO TO AO 

008618 

43 

V(l) = -V(5)*TDTJ 

008619 


V(2) = V(4l*T0TJ 

008620 


V(3) = ZRO 

008621 

40 

CALL MULTAD ( V,BS ( 1 , 1,NPTS ) ,G (LOU) ,1 ,3 , LFU, 1 ,6,1 ) 

008622 


IF (IMr(3,MW) .EO. 0) GO TO 35 

008623 


G(LMO) = TSHFT(NW) 

008624 


IF (LE .EO. O) GO TO 36 

008625 


CALL MULT3 (BS( 1 ,7,NPTSI ,YOT(LO) ,V,3,LF,1 ,6 ,1 , 1 ) 

008626 


CALL SKEWV3 (V,WSK,1,3) 

008627 


CALL MULT3 (MSK,V(4» ,V,3,3,1,3,1, 1 ) 

008628 


G(LMO) = G(LMO) - AM0(2,NW)*V(MAXI 

008629 

35 

CONTINUE 

006630 

C 


008631 

50 

CONTINUE 

008632 

C 


008633 

CCC 

SUBROUTINE EOADO ESTABLISHES ADDITIONAL CONTROL BLOCK EQUATIONS 

008634 

cccc 

TO SET UP SIMILARITY TRANSFORMATION. USED ONLY FOR LINEARIZATION 

008636 

cccc 

AND STABILITY PACKAGE. USER SUPPLIED — 

008636 


CALL EOADD 

008637 

c 


008638 


RETURN 

008639 


END 

008640 


i 


oonoonooonooo 


1 
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fHDG.P TPFB 
[FOR, IS TRFB 

COMPILER ( XM-n»(EOUIV=^CMN> 

SUBROUTINE TRFB C NC »RX,KR »KC ,K2tFPP tFLT ,GG» ZOV»K SI ZE 1 
IMPLICIT D^?ELE PR EC IS IW f A-H »0-Z I 
CTPFP TPANSFER INPUT ROOTS FORME AND FHRMC 

NO — IF INPUT (0) WF HAVE NUMERATOR» IF INPUT (1) A DENOMINATOR 
PX — ENTIRE BLOCK (COUNTS »GA1N»R00TS J 
KP — RUNNING COUNT DF ACCUMULATED REALS FOP ANY GIVEN CASE 
KC — SAME AS ABOVE BUT FOR COMPLEX 
KZ — CflUNT OF ACCUMULATED ZEROS FOR ANY GIVEN CASE 
PER — FORM CB) REAL STCRAGF BLOCK 
FBC — FORM (B) COMPLEX STORAGE BLOCK 
GG — RUNNING GAIN TERM 

20V — IF OUTPUT OTHER THAN. ZEROt ABSF(ZETA> EXCEEDED Cl) 
KSIZE DIMENSIONED SIZE OF FBR AND FBC . 

7t IS ASSUMED THAT THF COUNT FOR THE ACCUMULATED ROOTS WILL BE ZEROED 
OUT AT THE BEGINNING C^F EACH CASE. 

ANOTHER TASK IN THE (MAIN) PROGRAM IS CHECKING THE (ZETA) FLAG. 
DIMENSION RX(1 ) tFBRCDfFBCCl) 

IF (GG .FO. O.DO) ??ETUPN 
IE (ND.GT.O) GG TO 90 
IF (RXI7) .EO. O.DO) GO TO 200 
GG-GGARX (7) 

90 KRXl RX( 1)+ O.IDO 
KRX2 == RX(?)-^ O.IDO 
KRX3 = RX(3)+ O.IDO 
KRX4 = RX(4)+ O.IDO 
KRX5 = RX(S)+ O.IDO 
KRX6 RX(6)+ 0.100 
IF (ND) 100, 100, 110 
100 J = 7 

JCR - KRXl 
JCC = 2+KRX2 
JCZ = KRX3 
GO TO 120 

110J = 74^KRX1+2’«= KRX2 
JCR = KRX4 
JCC = 2^KRX5 
JCZ = KRX6 

120 IF (JCR) 150, 150, 130 
130 DO i.40 M = 1,JCR 
KR - KR-t^l 
L = J+M 

FBR(KR) = RX(L) 

140 CONTINUE 

150 IF (JCC) 190,190,160 
160 DO 180 M = 2, JCC, 2 
KC = KC+1 
KK = 2*KC 


-008641 

-00B642 

-00B643 

006644 

-006645 

008646 

008647 

008648 

008649 

008650 

008651 

008652 
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008653 

008656 

008657 

008658 

008659 

008660 

008661 
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008663 
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008665 
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008669 

008670 

008671 

008672 

008673 
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008675 
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008681 
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008687 

006688 

008689 

008690 
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L = J+JCR+M 008691 

FBCCKK-ll = RX«L-1) 008692 

FBCfKKI = RXCL) 008693 

IF lOABSIRXf L-U 1- 1.00» 180, 180, 170 008694 

170 ZOV =1.00 ’ 008695 

180 CONTINUE 008696 

190 KZ = KZ+JCZ 008697 

RETURN 008698 

200 GG=0.00 008699 

KR=0 008700 

KC=0 008701 

KZ=0 008702 

00 210 I=1,KS1ZE 008703 

FBR< 11=0-00 008704 

210 FBC( I 1=0.00 008705 

RETURN 008706 

END 008707 


onooonooooooooo 
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[HDG»P TTFF 
IFOR, IS TTFF 

COMPILFR ( XM^l), (EC-UIV=CMN) 

SUBROUTIME TTFF (NR ,NC ,NZ ,KP ,KC,KZ ,G,PN ,CN ,PD ,CD,P ,KS IZE) 
IMPLICIT DOUBLE PR EC ISICK ( A-H ,0-Z ) 

— — NR = NUMBER OF REAL ROOTS IN THE NUMERATOR 

NC " NUMBER OF COMPLEX PAIRS IN THE NUMERATOR 

NZ = NUMBER OF ZERO ROOTS IN THE NUMERATOR 

KR = NUMBER OF REAL ROOTS IN THE DENOMINATOR 

KC = NUMBER OF COMPLEX PAIRS IN THE DENOMINATOR 

KZ = NUMBER OF ZERO ROOTS IN THE DENOMINATOR 

G = GAIN 

RN = NUMERATOR REAL ROOT ARRAY 

CN = NUMERATOR COMPLEX PAIRS ARRAY , 

RD = OENOMINATCR REAL RCOt ARRAY 

CO = DENOMINATOR COMPLEX PAIRS ARRAY 

R = array CONTAINING NUMBER OF ROOTS AND ROOT ARRAYS. 

-KSIZE- = DIMENSIONED SIZE OF R IN CALLING PROGRAM. 

DIMENSION P^M1),CN(1 ),RDn),CD(l),Pll) 

IF (G.EQ.0.00) GO TO KO 
R( 1)=NR 
R(2)=NC 
R(3)=NZ 
R(4»=KR 
R(5)=KC 
R(6)-KZ 
R(7)=G 
L=7+NR 

IF (NR.EO.O.DO) GO TO 20 
DO 10 1=8, L 
10 R(I)=RN(I-7) 

20 M=L+1 

L=L+2*NC 

IF (NC.LE.O ) GO TO AO 
DO 30 I=M,L 
J=I-M+1 
30 R(I)=CN(JI 
40 M=L+1 
L=L+KR 

IF(KR.LE.O) GO TO 60 
DO 50 I=M,L 
J=I-M+1 
50 R(I)=RD( J) 

60 IF(KC.LE.O) RETURN 
M=L+1 
L=L+2*KC 
DO 70 I=M,L 
J=I-M+1 
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-008709 
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70 RfI»=C0CJ) 008758 

RETURN 008759 

80 DO 90 I=1»KSIZE 008760 

90 R(I)=0.0D0 008761 

RETURN 008762 

END 008763 


ooooonono 
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[HDG.P UNITY -006764 

IFPR,1S UNITY -008765 

COMPILER ( XM=n,(EOUIV=CMN) -008766 

SUBROUTIME UNITY (Z,N»KR) 008767 

IMPLICIT nnUBLE PP.EClSICN(A-+i,P-Z» -008768 

DIMENSION Z(KR,1) 008769 

008770 

GENERATE A UNITY MATRIX. (ONES ON THE DIAGONAL >. 008771 

CODED BY RL WOHIEN. FFP 1965. 008772 

008773 

SUBROUTINE ARGUMENTS 008774 

Z = OUTPUT MATRIX GENERATED. SIZEtN,N). 008775 

N = INPUT SIZE OF MATRIX Z (SQUARE!. 008776 

KR = INPUT Rt?W DIMENSION OF MATRIX Z IN CALLING PROGRAM. 008777 

008776 

DO 20 1=1, N 008779 

DO 10 J=1,N 008780 

10 Z(I,J) = O.D 0 008781 

20 Z(I,I) = 1 .D 0 008782 

RETURN 008783 

END 008784 


1 


1 


i 


i 
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[HDGtP WRITF 
IFORflS WRITE 

COMPILER ( XM=:I I « CEOUIV=CMM> 

SUBROUTINE WRITE C A »NR,NC , ANAMEt KR ) 

DOUBLE PRECISION A 
DIMENSION A(KP,1) 

DATA NOT / 6/ 

C 

C WRITE MATRIX OF REAL NUMBERS ON PAPER. 

C RECUIRES 123 COLUMN (MINIMUM) PRINTER. 

C UP TO 10 DATA FIELDS PER LINE. PRINTS ONLY NON-~ZFRC FIELD ROWS. 
C CALLS FORMA SUBROUTINE PAGEHD. 

C CODED BY RL WOHLFN. DECEMBER 1968. 

C 

C SUBROUTINE ARGUMENTS (ALL INPUTT 

C A = MATRIX TO BF PRINTED. SI2E(NR»NC). 

C NR = NUMBER OF ROWS IN MATRIX A. 

C NC = NUMBFR OF COLS IN MATRIX A. 

C ANAME = MATRIX IDENTIFICATION. ( A6 FORMAT). 

C KR = ROW DIMENSION OF A IN CALLING PROGRAM. 

C 

2010 FORMAT (//15H OUTPUT MATRIX A6,2X 1H(I4,2H X IA»2H ) // 

♦ 10X,10(7Xt 1H( I2tlH))/) 

2020 FORMAT (//15H OUTPirT MATRIX A6,2X 1H(I4»2H X I/^,2H ) 

♦ 3Xt 9HC0NTINUED //10X,10(7X^1H( 12, IH))/) 

2030 FORMAT ( IX ,2 1 5,2X, IP lODM . 3 ) 

2040 FORMAT (14H0END OF WRITE.) 

C 

C PULL UP A NEW PAGE FOR MATRIX AND PRINT MATRIX NAME. 

CALL PAGEHD 

WRITE (NOT, 2010) ANAME ,NR ,NC, ( L,L=1 , 10) 

NLINE = 0 
C 

no 60 1 = 1 , NP 

NZERO = 0 
JS = 1 

10 JE = JS+9 

IF CJE .GT. NC) JE=NC 
C SEE IF ELEMENTS APE ZERO. 

DO 20 J=JS,JE 

20 IF CAfliJ) .NE. 0.0 0) GO TO 30 
GO TO 40 

30 NLINE = NLINE+1 

IF (NLINE .LE. 44) GO TO 35 
CALL PAGEHD 

WRITE (N0T,2020) ANAME,NR ,NC, ( L,L=1, 10 ) 

NLINE = 1 

35 WRITE (NOT, 2030) I , JS , ( A( I , J) , J=JS,JE) 

NZERO = 1 

40 IF (JE .EQ. NC) GO TO 50 
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JS = JS+10 008835 

GO TO 10 008836 

C SKIP A SPACE BETWEEN EACH ROW IF THERE ARE MORE THAN 10 COLUMNS 008637 

C AND SOMETHING HAS BEEN WRITTEN. 008838 

60 IF (NC.LE.IO .OR. NZERO.EO.O .0«. I.EQ.NR) 60 TC 60 008839 

NLINE = NLINE-^l 0088A0 

WRITE {NOT, 2030) 008841 

60 CONTINUE 008842 

C 008843 

ViRITE (NOT, 2040) 008 644 

RETURN 006845 

END 008046 


IHOG,P WRITES 
[FOR, IS WRITES 

COMPILER (XMsll,(EQUIV=CMNI 
SUBROUTINE WRITES IA#NR,NC,KR) 

DOUBLE PRECISION A 
DIMENSION AtKR«l)*ICHEADI10) 

DATA NOT / 6/ 

DATA ICHEAD/AHI 2ltAH( 3),4H< A),4H« 5), 

♦ . AHI 6)t4H< 7I,4H( 9) / 

C 

2010 FORMAT ( 8X,10{7X,A4)) 

2030 FORMAT MX ♦2I5»2X, IPlODll .3 ) 

C 

LR = 10 

IF INC .LT. LR) LR = NC 

WRITE (NOT, 2010) ( ICHEAD (L) , L-1,LR) 

DO 60 1=1, NR 
JS = 1 

10 JE = JS + 9 

IF IJE .GT. NC) JE = NC 

WRITE (NOT, 2030) I,JS, I A ( I , J ) , J=JS, JE ) 

IF (JE .EO. NC) GO TO 60 
JS = JS + 10 
GO TO 10 
60 CONTINUE 
C 

RETURN 

END 
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[HOG,P WPITIS 

[FOR, IS WRTTIS 

COMPILFR f XM=:1 (FC:UTV=:CMN) 

SUBROUTINE WRITIS C IM t NR »NC »KR ) 
niMENSiDN 1M(KR,1), ICHC20) 

DATA NOT / 6/ 

DATA ICH / 

^ AH( 1)»4HC 2),4H« 3>»4H( 4) »4H( 5)tAHC 6)»AH( 7)tAH( 8», 
» 4HC 9) ,AH(10) f 

* 4H(11 >,4HC12ltAH«13)tAHnA>»AHC15)»4H(16l ,4H( 17 » t4H ( 18 ) t 

* 4HC19J ,^HC20) / 

C 

2001 FORMAT (ITXPOnyfAA)) 

2002 FORMAT ( IX ,2 15 *5X ,2015 ) 

C 

LR = 20 

IF (NC .LT. LR) LP NC 
WRITE (NOT, 2001) C ICH ( L) , L- 1 , LP I 
DO 60 1=1, NR 
JS = 1 

10 JE = JS + 19 

IF ( JE .GT. NO JE = NC 

WRITE (NOT, 2002) I,JS, ( IM I I , J ) , J=JS , JE ) 

IF (JE .EO. NC) GO TO 60 
JS = JS ♦ 20 
GO TO 10 
60 CONTINUE 
C 

RETURN 

END 
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DATA IFLAG / 1 / 

IF CJIL .EG . A) IFLAG = 1 

CALL ROTDH 
CALL 

CALL R0TDS 
CALL PSGENT? 

Call mgen 

IF (MLAM .GT. 0) CALL FINDU (IFLAG) 

DO 10 L=lfNP 
LO - lOCU(L) 

LE LENU(L) 

10 CALL MULT3 ( AMU (1 1 1 1 L ) tY ( LC) ,P (LO) , LE , LE 1 1 »KMU, 1 1 1 ) 
DO 11 1=1, MU 

11 GGy/il) = ZRn 
CALL GRVGRr (GGV) 

00 15 L=1,NB 

LE = LENU(L) 

15 CALL INVir4P ( AMU ( 1 ,1 , L) , AMU ( 1 , 1 ,L ) ,LE ,KMU) 

IF (NLAM .FO. 0) GO TO 200 
CALL GETBMB 
KBMB = 6*NHMAX 

CALL DC0M2 (BMB ,D,NLAM,KBMB) 


CC CALCULATE BETADT AND PLACE INTO YOT 
200 IC = LnCU(?=*NB+l) - 
00 60 L=1,NH 
00 60 1=1,6 
IPl = I + 1 

IF (IHDATA(TP1,L) .EG. 1) GO TO 60 

IC = IC + 1 

YDT(IC) = 2R0 

IF CL .EG. 1) GO TO 61 

NOBQ = ITOPGL(lfL) 

NOBP = IT0PGL(2,L) 

LQ = 2*L - 2 
LP = LQ + 1 
LOO LOCU(NOBQ) - 1 
LOP = LOCU(NOBP) - 1 
LEO = IRGFLX(NOBQ) + 6 
LEP = IRGFLX(NOBP) + 6 
DO 62 J=1,LEQ 
LOQJ = LOG + J 

62 YDT(IC) = YDT(IC) + BH( I , J , LQ )*Y( LOO J ) 
DO 63 J=1,LEP 

LOPJ = LOP J 

63 YOT(IC) = YDT(IC) ♦ BH( I , J, LP )*YI LOP J ) 
BETAHO«T,L) = YOT(IC) 
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GO TO 60 

61 LEG = IRGFLXdl + 6 
DO 64 J=1 tLEO 

64 YDTCICI = YDTilC) + BH( I , J , 1 ) ♦YU ) 

BETAH0(I,L» = YDTCICI 

60 CONTINUE 

PUT MODAL VELOCITIES (XECDCTM INTO YDOT 

DO 65 N=1»NP 
LE = IRGFLXCN) 

IF ILE .EQ. 01 GO TO 65 
LOU = LOCUCN) + 5 
LO = LOCUCN+NB) - 1 
DO 66 Js^l.LE 
66 YDTCLOU) = YCLOU+J) 

65 CONTINUE 
C 

CALL TORCUF CGGVI 
C 

CC INITIALIZE UDOT, GET RHS OF LAMBDA EQUATION 
C 

DO 70 N=1,NB 
LO = LOCUCW) 

LE = LENUINI 

70 CALL MULT3 C AMU ( 1 ,1 ,N ) ,GGVCLO I tYOTC LO ) ,LE t L E ♦ 1»KMU, 1 , 1 ) 
C 

IFLAG = 2 

IF CNLAM •FQ, 01 RETURN 
C 

DO 80 L=1,NH 

CALL BDOTQP ( L,BOTC,BDTP I 

DO 80 1=1,6 

IPl = I + 1 

IC = IV(I,LI 

IF CIC .EQ. 0) GO TO 80 

VIICI = ZRO 

lie = 6*(L-1) ♦ I 

IF CIHDATA CIP1,L) .EQ. 2) VCICI = ADDT(I1C,T) 

IF CL .EQ. 1) GO TO ei 
NOBQ = ITOPOLClfLl 
NOBP = ITOPOLC2,L) 

LO = 2*L - 2 

LP = LQ + I 

LOG = LOCUCNOBO) - 1 

LOP = LOCUCNOBP) ~ 1 

LEQ = IRGFLXCNOBQ) + 6 

LEP = IRGFLXCNOBP) +6 

DO 82 J=1,LEQ 

LOQJ = LOQ + J 
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82 V(IC) = VITCI - PHII,J,LQI*YOT|LCOJ) - ROTO ( I , J !♦ Y| LOCJ I 
DO 83 J=1,LFP 

LGPJ = LOP + J 

83 V(IC) = VfICI - PH(I,J,LP)*VOHLOPJI - BOTP(I,J|*VfLOPJI 
GO TO 80 

81 LEO = IPGFLXn » ♦ 6 
DO 84 J=1,LE0 

84 vnc) = V(IC) - BH(1 ,J,1)*V0T(J> - BOTOC I .J >*V< J I 
60 CONTINUE 

IF (NLAM .GT. 1) GO TO 305 
vm = vn )/D(i) 

GO TCI 310 

305 CALL BAKSLV CBMB *NLAM*VtO,KBMB I 

310 LFC = LENUm 
00 85 1=1*6 
ILN = IV(I ,1 ) 

IF (ILN .EC. 01 GO TO 85 
F - V(ILN) 

DO 86 J=1,LEQ 

86 VOT(J) = YDT(J) + F*BM(I»J*I1 

85 CONTINUE 

DO 90 L=?,NH 
NOBO = ITOPnL(l,L) 

NOBP = IT0PGU2*L) 

LO = 2*L - 2 

LP = LO ♦ 1 

LOO = LOCU(NCBQI - 1 

LOP = LOCU(NOBP) - 1 

LEG = LENU(NOBQ) 

LEP = LENUINCBP) 

DO 90 1=1, b 
ILN = IV (I, L) 

IF (ILN .EO. 0) GC TO 90 
F = VflLNI 
DO 95 J=1,LE0 
LOOJ = LOO ♦ J 

95 YOT(LOOJ) = YOT(LOOJ) ♦ F*BM(I,J,LC1 
DO 96 J=1,LEP 

LOPJ = LOP + J 

96 YOT(LOPJ) = YDT(LOPJ) ♦ F*BMfI,J,LPI 
90 CONTINUE 

RETURN 

END 


009055 

009056 

009057 

009058 

009059 

009060 

009061 

009062 

009063 

009064 

009065 

009066 

009067 

009068 

009069 

009070 

009071 

009072 

009073 

009074 

009075 

009076 

009077 

009078 

009079 

009080 

009081 

009082 

009083 

009084 

009085 

009086 

009087 

009088 

009089 

009090 

009091 

009092 

009093 

009094 

009095 

009096 

009097 

009098 

009099 

009100 

009101 



onooooooooooo 


I 


1 




?32 


[HD6«P YOOTL 

[FORtlS YDOTL 

COMPILER C XM=1», (EOUIV=CMN> 

SUBROUTINE YDOTL ( A,B,Y,YD,NY,KA) 

IMPLICIT DOUBLE PR EC ISION ( A-H ,0-Z ) 

SUBROUTINE FORMS THE LINEARIZED YOOT VECTOR. 

-SUBROUTINE ARGUMENT DESCRIPTIONS 

A = INPUT LINEARIZED COEEFICIENT5. SIZE NA BY NY. 

USED IN EXPRESSION YD = A ♦ Y 4 B 
B = INPUT EXTERNAL FORCING TORCUES. USER SUPPLIED VIA 

SUBROUTINE LTOROL. 

Y = INPUT VECTOR OF STATE VARIABLES. 

YD = OUTPUT VECTOR OF STATE VECTOR TIME DERIVATIVES. 

NY = SIZE OF STATE VECTOR TO BE INTEGRATED. 

DIMENSION ACKA,l),Bf l),YCl)tYO«l) 

C 

DO 10 1 = 1, NY 
YD(I) = B(I) 

00 10 J=1,NY 

VOID = YD(I) 4 A(1,JI ♦ YU) 

10 CONTINUE 
RETURN 
END 
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fHOG.P ZEPO 
fFOR.IS ZEPO 

COMPILER CXM=1), (EOUIV=CMN> 
SUBROUTINE ZERO (Z,NR,NCtKR) 
IMPLICIT DOUBLE PREC1SI0N(A-H»0-Z) 
DIMENSION Z(KRtU 

GENERATE A MATRIX OF ZEROES. 

CODED BY RL WOHLFN. FEB 1965. 


SUBROUTINE ARGUMENTS 

Z = OUTPUT MATRIX GENERATED. SIZE<NR,NCJ. 

NR = INPUT NUMBER OF ROWS IN MATRIX Z. 

NC = INPUT MUMBER OF COLS IN MATRIX Z. 

KR = INPUT ROW DIMENSION OF MATRIX Z IN CALLING PROGRAM 


10 


DO 10 1=1, NR 
DO 10 J=1,NC 
ZCItJ) = O.D 
RETURN 
END 
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CDCDICD //// END OF LIST //// 
CDCDICD //// END OF LIST //// 


